同じプロセスをループスルーブックに適用

Question

Excelブックをループして同じシートに同じピボットテーブルを作成しようとしていますが、各シートには同じ列に異なるデータが含まれています。ピボットテーブルは機能しますが、ループは最初のワークシートの完了後に停止します。

誰かがループをすべてのワークシートで実行するための推奨事項はありますか？

Sub PivotTableLoop() 

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 
Dim wb     As Workbook 

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

'Beginning of Loop 
For Each ws In ActiveWorkbook.Worksheets 

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

'set range for Pivot table placement 
Set TableDest = Sheets(DataSheet).Cells(1, 9) ' conversion of R1C9 

Set PvtCache = ActiveWorkbook.PivotCaches.Add(xlDatabase, DataRng) 

'this line in case the Pivot table doesn't exit >> first time running this Macro 
On Error Resume Next 
Set PvtTbl = ActiveWorkbook.Sheets(DataSheet).PivotTables("PivotTable4") ' check if "PivotTable4" Pivot Table already created (in past runs of this Macro) 

On Error GoTo 0 
If PvtTbl Is Nothing Then ' "PivotTable4" doesn't exist >> create it 

'create a new Pivot Table in "PivotTable4" sheet 
Set PvtTbl = ActiveWorkbook.Sheets(DataSheet).PivotTables.Add(PivotCache:=PvtCache, TableDestination:=TableDest, TableName:="PivotTable4") 

With PvtTbl.PivotFields("Document Type") 
    .Orientation = xlRowField 
    .Position = 1 
End With 

With PvtTbl.PivotFields("Accounting Event") 
    .Orientation = xlRowField 
    .Position = 2 
End With 

With PvtTbl.PivotFields("Document Number") 
    .Orientation = xlRowField 
    .Position = 3 
End With 
PvtTbl.AddDataField ActiveSheet.PivotTables(_ 
"PivotTable4").PivotFields("Amount"), "Sum of Amount", xlSum 

    ActiveCell.Offset(1, 0).Range("A1").Select 
PvtTbl.PivotFields("Document Type").ShowDetail _ 
    = False 
ActiveCell.Offset(-1, 0).Range("A1").Select 
PvtTbl.CompactLayoutRowHeader = _ 
    "JIFMS Document Types" 
ActiveCell.Offset(2, 1).Range("A1").Select 
PvtTbl.PivotSelect "", xlDataAndLabel, True 
PvtTbl.DataPivotField.PivotItems(_ 
    "Sum of Amount").Caption = "JIFMS Sum of Amounts" 
ActiveCell.Offset(5, 0).Range("A1").Select 
Else 

'just refresh the Pivot cache with the updated Range 
PvtTbl.ChangePivotCache PvtCache 
PvtTbl.RefreshTableenter code here 

End If 

Next ws 

End Sub 

Answer 1

まず、インデントあなたのコードに学びます。すべてのコードブロックの内容が列1にあるときにコードを読むと、頭が回転します。読みにくいコードは、デバッグが難しいコードです。

VBEアドインを入手してください。 32ビットOfficeをご使用の場合は、スマートインデントを使用してください。あなたが64ビットオフィスにいるなら、最新のMZ-Tools（$$$私は思う）、またはフリーでオープンソースのRubberduck（免責事項、私はひどく関わっている）を使うことができます。 x（まだベータ版）にはスマートインデントの機能のほとんどが含まれています。

はまた、この一つとして迷惑と無用ラインの継続を取り除く：

あなたが後に戻っ Nothingから PvtTblを設定していない/暴言

---

PvtTbl.PivotFields("Document Type").ShowDetail _ 
    = False 

最初の反復であるため、If...End Ifブロック全体が参照が一度割り当てられた後には実行されません。おそらく最初のiteraになります。

ループの本体を独自のプロシージャに抽出することにより、ループの本体に本来スコープを持つPvtTblを指定することで、問題を排除してコードの可読性を向上させることができます。この操作は「抽出メソッド」リファクタリングと呼ばれます。

アクティブワークブック内のすべてのワークシートも繰り返し処理していますが、ループ本体のどこにでもwsを使用していないため、すべてがアクティブシートから機能します。