単一のデータソースから複数のピボットテーブルを作成する

Question

新しいシートにピボットテーブルを作成しようとしています。さらに、最初のデータシートから同じデータを使用して別のピボットテーブルを作成する別の呼び出しを作成したいと思います。

下記のマクロで問題があります。私はそれが小さな誤りだと思うが、それを理解することはできない。

Sub Macro2() 

    Dim FinalRow   As Long 
    Dim DataSheet   As String 
    Dim PvtCache   As PivotCache 
    Dim PvtTbl    As PivotTable 
    Dim DataRng    As Range 
    Dim TableDest   As Range 
    Dim ws     As Worksheet 

    FinalRow = Cells(Rows.Count, 1).End(xlUp).Row 
    DataSheet = ActiveSheet.Name 

    'set data range for Pivot Table -- ' conversion of R1C1:R & FinalRow & C15 
    Set DataRng = Sheets(DataSheet).Range(Cells(1, 1), Cells(FinalRow, 15)) 

    Set ws = Worksheets.Add 
    ws.Name = "Travel Payment Data by Employee" 

    'set range for Pivot table placement -- Conversion of R1C1 
    Set TableDest = Sheets("Travel Payment Data by Employee").Cells(1, 1) 

    Set PvtCache = ActiveWorkbook.PivotCaches.Create(xlDatabase, DataRng, xlPivotTableVersion15) 

    'check if "PivotTable4" Pivot Table already created (in past runs of this Macro) 
    Set PvtTbl = ActiveWorkbook.Sheets("Travel Payment Data by Employee").PivotTables("PivotTable4") 

    With PvtTbl.PivotFields("Security Org") 
     .Orientation = xlRowField 
     .Position = 1 
    End With 
    With PvtTbl.PivotFields("Fiscal Month") 
     .Orientation = xlRowField 
     .Position = 2 
    End With 
    With PvtTbl.PivotFields("Budget Org") 
     .Orientation = xlRowField 
     .Position = 3 
    End With 
    With PvtTbl.PivotFields("Vendor Name") 
     .Orientation = xlRowField 
     .Position = 4 
    End With 
    With PvtTbl.PivotFields("Fiscal Year") 
     .Orientation = xlRowField 
     .Position = 5 
    End With 
    With PvtTbl.PivotFields("Fiscal Year") 
     .Orientation = xlColumnField 
     .Position = 1 
    End With 
    PvtTbl.AddDataField ActiveSheet.PivotTables(_ 
     "PivotTable2").PivotFields("Dollar Amount"), "Sum of Dollar Amount", xlSum 

End Sub 

Answer 1

新しいピボットテーブルに新しいワークシート名を渡して、関数を呼び出すサブルーチンを使用して、次の調整を考慮してください。同一のピボットを意図していない場合は、シート名または機能のコピーによって条件付きでコードを調整します。次のようにあなたのコードからの主な変更点は以下のとおりです。

1. ACTIVE SHEET：より多くのワークシートがアクティブシートを変更します追加などActiveSheet.Nameを検索する必要性を削除します。パラメータをハードコードするか、パラメータとして渡すだけです。
2. OBJECT CHECK：ワークシートが終了し、ピボットテーブルが存在するかどうかを確認する必要があります。そのためには、現在のすべてのオブジェクトを繰り返し処理し、ワークシート、ピボットテーブルオブジェクトを条件付きで設定する必要があります（For...NextループとIf ... Is Nothingチェックを参照）。
3. ピボットテーブルの場合、ドル金額はピボットテーブルデータソースに存在しますが、必ずしも表示する必要はありません。これらのすべてを反復すると、上記のように動作しない可能性があります。条件付きで追加する場合は、エラーが発生しない場合にのみOn Resume Nextハンドルを参照してください。

VBA 2番目のピボットテーブルのオブジェクトを試みるん

Option Explicit 

Public Sub RunPivots() 
    Call BuildPivot("Travel Payment Data by Employee") 
    Call BuildPivot("Other Worksheet") 
    Call BuildPivot("Still More Worksheet") 
End Sub 

Function BuildPivot(paramSheet As String) 
On Error GoTo ErrHandle 
    Dim FinalRow   As Long 
    Dim DataSheet   As String 
    Dim PvtCache   As PivotCache 
    Dim PvtTbl    As PivotTable 
    Dim PvtFld    As PivotField 
    Dim DataRng    As Range 
    Dim TableDest   As Range 
    Dim ws     As Worksheet 

    FinalRow = Cells(Rows.Count, 1).End(xlUp).Row 

    DataSheet = "DataSourceWorksheet"  
    ' set data range for Pivot Table 
    Set DataRng = Sheets(DataSheet).Range(Cells(1, 1), Cells(FinalRow, 15)) 

    ' check if worksheet exists 
    Dim currws As Worksheet 
    For Each currws In ActiveWorkbook.Worksheets 
     If currws.Name = paramSheet Then 
      Set ws = Worksheets(paramSheet) 
      Exit For 
     End If 
    Next currws 

    ' create new worksheet if does not exist 
    If ws Is Nothing Then 
     Set ws = Worksheets.Add 
     ws.Name = paramSheet 
    End If 

    ' set range for Pivot table placement 
    Set TableDest = Sheets(paramSheet).Cells(1, 1) 

    ' create pivot cache 
    Set PvtCache = ActiveWorkbook.PivotCaches.Create(_ 
       SourceType:=xlDatabase, _ 
       SourceData:=DataRng, _ 
       Version:=xlPivotTableVersion15) 

    'check if "PivotTable4" Pivot Table exists    
    Dim currpvt As PivotTable 
    For Each currpvt In ws.PivotTables 
     If currpvt.Name = "PivotTable4" Then 
      Set PvtTbl = ws.PivotTables("PivotTable4") 
      Exit For 
     End If 
    Next currpvt 

    ' create new pivot table if does not exist 
    If PvtTbl Is Nothing Then 
     Set PvtTbl = PvtCache.CreatePivotTable(_ 
      TableDestination:=TableDest, _ 
      TableName:="PivotTable4") 
    End If 

    With PvtTbl.PivotFields("Security Org") 
     .Orientation = xlRowField 
     .Position = 1 
    End With 
    With PvtTbl.PivotFields("Fiscal Month") 
     .Orientation = xlRowField 
     .Position = 2 
    End With 
    With PvtTbl.PivotFields("Budget Org") 
     .Orientation = xlRowField 
     .Position = 3 
    End With 
    With PvtTbl.PivotFields("Vendor Name") 
     .Orientation = xlRowField 
     .Position = 4 
    End With 
    With PvtTbl.PivotFields("Fiscal Year") 
     .Orientation = xlRowField 
     .Position = 5 
    End With 
    With PvtTbl.PivotFields("Fiscal Year") 
     .Orientation = xlColumnField 
     .Position = 1 
    End With 

    ' Add data field if does not exist 
    On Error Resume Next 
    PvtTbl.AddDataField PvtTbl.PivotFields("Dollar Amount"), "Sum of Dollar Amount", xlSum 

    Exit Function 

ErrHandle: 
    MsgBox Err.Number & " - " & Err.Description, vbCritical, "RUNTIME ERROR" 
    Exit Function 
End Function