2

次のようなExcelのピボットテーブルがあります。

Team         Doc 1  Doc 2   Grand Total
Team A       13     12      25
Team B       8      7       15
Team C       32     5       37
Grand Total  53     24      77

ドリルダウン シートを印刷用にフォーマットする VBA の一部を既に作成しています (Workbook_NewSheet(ByVal Sh As Object))。ただし、これをできるだけユーザーフレンドリーにしようとしているので、vba を使用して、ピボット テーブルから生成されたワークシートの名前を自動的に変更できるようにしたいと考えています。ただし、各ワークシートの内容はユーザーがクリックする場所によって異なるため、その方法はわかりません (つまり、ユーザーが Team A Doc 1 Total をクリックした場合、シートの名前は「Team A Doc 1」にする必要があります)。ただし、ユーザーがDoc 2のGrand Total行をクリックすると、シートの名前は「Grand Total Doc 2」になるはずです）-15の異なるワークシート名が発生する可能性があると思います。そのため、ワークシートのデフォルトはシート1！私'

ありがとう

4

2 に答える 2

2

コメントできればいいのですが、担当者が足りないのでまだできません! (アカウントを再起動する必要がありました!)

特定のデータ ポイントを手動でドリルダウンしながらマクロを記録し、記録された vba コードがどのように見えるかを確認することをお勧めします。そこから、記録されたコードのいくつかの要素に基づいてワークシートの名前を設定するようにコードを構成できると思います。

これはコメントにしたかったので、役に立たなかったら削除します。

新しく投稿された回答への更新:

ユーザーがドリルダウンしたときにシートが既に存在するかどうかを確認するには、シート名を取得した後にシートが存在するかどうかを確認し、存在する場合は、新しいシートを作成するのではなく選択します。それ以外の場合は、作成します。

そのためには、次のコードを参照してください。

Private Sub Workbook_NewSheet(ByVal sh As Object)

Application.ScreenUpdating = False

Dim shtCur As Worksheet
Set shtCur = ActiveSheet

Sheets("DQ Summary").Select
RN = ActiveCell.Row
CN = ActiveCell.Column
SheetName = Cells(RN, 2).Value & " - " & Cells(9, CN).Value


If SheetExists(SheetName) Then
    Worksheets(SheetName).Select
Else

    shtCur.Move _
        After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
    shtCur.Name = "SheetName"
End If


Application.ScreenUpdating = True


End Sub

Function SheetExists(wsName As String, Optional wb As Workbook = Nothing) As Boolean

SheetExists = False
Dim WS As Worksheet

If wb Is Nothing Then Set wb = ThisWorkbook

On Error Resume Next
Set WS = wb.Worksheets(wsName)
On Error GoTo 0

If Not WS Is Nothing Then SheetExists = True

End Function
于 2012-08-02T13:15:10.993 に答える
1

私はかなり実行可能なものを思い付くことができました：

Private Sub Workbook_NewSheet(ByVal sh As Object)

Dim RN, CN As Byte
Dim SheetName As String

Application.ScreenUpdating = False

ActiveSheet.Move _
After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)

'Names the sheet according to the pivot drill

Sheets("DQ Summary").Select
RN = ActiveCell.Row
CN = ActiveCell.Column
SheetName = Cells(RN, 2).Value & " - " & Cells(9, CN).Value

'Identifies if worksheet already exists and replaces it if so.
Application.DisplayAlerts = False
On Error Resume Next
mySheetNameTest = Worksheets(SheetName).Name
If Err.Number = 0 Then
Worksheets(SheetName).Delete
    MsgBox "The sheet named ''" & SheetName & "'' already exists but will be replaced."
Else
    Err.Clear
End If
Application.DisplayAlerts = True

Sheets(ActiveWorkbook.Sheets.Count).Select
ActiveSheet.Name = SheetName    

End Sub

基本的に、これは newsheet イベントに追加されます - マクロは新しいシートをワークブックの最後に追加し、ピボット テーブル シートに移動して、アクティブ セルの列名と行名を識別します (列名と行名は常に静的であるため)これをハード コードできます)、新しく追加されたシート (常にワークブックの最後) を見つけて、名前を変更します。残念ながら、ユーザーが同じデータを 2 回ドリルしようとすると問題が発生します (同じ名前のワークシートを 2 つ持つことはできません)。これを解決したいと考えています。

ビュー/コメントをありがとう。

編集:ワークシートの重複の問題を回避するためにコードを更新しました。うまくいっているようです!

于 2012-08-02T13:42:05.423 に答える