ここでは 複数ブックにまたがって条件付きでピボットテーブルを複数種類同時に削除・再作成する VBAの例を紹介します。ポイントは「複数ブックをループし、条件に合致するシートを判定して、そのシートにある複数のピボットテーブルを削除し、新しいピボットテーブルを作り直す」ことです。
基本例：すべてのブックの「Data」シートにあるピボットを削除 → 数量・売上のピボットを再作成
Sub 複数ブックでピボット削除再作成()
Dim wb As Workbook
Dim ws As Worksheet
Dim pt As PivotTable
Dim pc As PivotCache
Dim destWs As Worksheet
Dim lastRow As Long
For Each wb In Application.Workbooks
If wb.Name <> ThisWorkbook.Name Then
For Each ws In wb.Worksheets
' 条件：シート名が「Data」
If ws.Name = "Data" Then
' 既存のピボットテーブルを削除
For Each pt In ws.PivotTables
pt.TableRange2.Clear
Next pt
' データ範囲を取得
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
' ピボットキャッシュ作成
Set pc = wb.PivotCaches.Create( _
SourceType:=xlDatabase, _
SourceData:=ws.Range("A1:D" & lastRow))
' 数量ピボットを新規作成
Worksheets.Add(After:=ws).Name = "Pivot_数量"
pc.CreatePivotTable TableDestination:=wb.Worksheets("Pivot_数量").Range("A3"), _
TableName:="数量ピボット"
With wb.Worksheets("Pivot_数量").PivotTables("数量ピボット")
.PivotFields("商品").Orientation = xlRowField
.PivotFields("数量").Orientation = xlDataField
End With
' 売上ピボットを新規作成
Worksheets.Add(After:=ws).Name = "Pivot_売上"
pc.CreatePivotTable TableDestination:=wb.Worksheets("Pivot_売上").Range("A3"), _
TableName:="売上ピボット"
With wb.Worksheets("Pivot_売上").PivotTables("売上ピボット")
.PivotFields("商品").Orientation = xlRowField
.PivotFields("売上").Orientation = xlDataField
End With
End If
Next ws
End If
Next wb
End Sub
👉 開いているすべてのブックで「Data」シートにある既存ピボットを削除し、数量用ピボットと売上用ピボットを再作成します。
応用例1：セルの値で判定して削除・再作成
Sub セル値でピボット削除再作成()
Dim wb As Workbook
Dim ws As Worksheet
Dim pt As PivotTable
Dim pc As PivotCache
Dim lastRow As Long
For Each wb In Application.Workbooks
For Each ws In wb.Worksheets
' A1セルが「再作成」と書かれていたら対象
If ws.Range("A1").Value = "再作成" Then
' 既存ピボット削除
For Each pt In ws.PivotTables
pt.TableRange2.Clear
Next pt
lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
Set pc = wb.PivotCaches.Create(SourceType:=xlDatabase, _
SourceData:=ws.Range("A1:C" & lastRow))
' 新しいピボットを作成（数量・売上）
Worksheets.Add(After:=ws).Name = "Pivot_数量"
pc.CreatePivotTable TableDestination:=wb.Worksheets("Pivot_数量").Range("A3"), _
TableName:="数量ピボット"
Worksheets.Add(After:=ws).Name = "Pivot_売上"
pc.CreatePivotTable TableDestination:=wb.Worksheets("Pivot_売上").Range("A3"), _
TableName:="売上ピボット"
End If
Next ws
Next wb
End Sub
応用例2：複数条件を組み合わせて削除・再作成
Sub 複数条件でピボット削除再作成()
Dim wb As Workbook
Dim ws As Worksheet
Dim pt As PivotTable
Dim pc As PivotCache
Dim lastRow As Long
For Each wb In Application.Workbooks
For Each ws In wb.Worksheets
' 条件1: シート名が「Sales」で始まる
' 条件2: B2セルが100以上
If Left(ws.Name, 5) = "Sales" And ws.Range("B2").Value >= 100 Then
' 既存ピボット削除
For Each pt In ws.PivotTables
pt.TableRange2.Clear
Next pt
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
Set pc = wb.PivotCaches.Create(SourceType:=xlDatabase, _
SourceData:=ws.Range("A1:D" & lastRow))
' 数量・売上ピボットを再作成
Worksheets.Add(After:=ws).Name = "Pivot_数量"
pc.CreatePivotTable TableDestination:=wb.Worksheets("Pivot_数量").Range("A3"), _
TableName:="数量ピボット"
Worksheets.Add(After:=ws).Name = "Pivot_売上"
pc.CreatePivotTable TableDestination:=wb.Worksheets("Pivot_売上").Range("A3"), _
TableName:="売上ピボット"
End If
Next ws
Next wb
End Sub
ポイント
- 既存ピボット削除 →
pt.TableRange2.Clearでピボットの範囲を消去 - 新規ピボット作成 →
PivotCaches.Create→CreatePivotTable - 複数種類を同時作成 → 同じキャッシュから複数ピボットを生成可能
- 条件判定 → シート名やセルの値を使って柔軟に対象を絞り込み
練習課題
- 全ブックの「Sheet2」にあるピボットを削除し、数量・売上のピボットを再作成するコードを書いてみる
- 各シートのC1セルが「Rebuild」と書かれていたら複数ピボットを削除・再作成するコードを作る
- 複数条件を組み合わせて「シート名がReportで始まり、A1セルが空でないなら数量・売上の両方を再作成する」コードを作る
こうした仕組みを作ると、複数ブックにまたがって条件付きでピボットテーブルを複数種類同時に削除・再作成する自動化ツールが完成します。
