ここでは 複数ブックにまたがって条件付きでピボットテーブルを新規作成する VBAの例を紹介します。ポイントは「複数ブックをループして条件に合致するシートのデータを統合し、その統合データを元にピボットテーブルを新規作成する」ことです。
基本例：各ブックの「Data」シートを統合 → ピボットテーブル新規作成
Sub 複数ブックでピボット新規作成()
Dim wb As Workbook
Dim ws As Worksheet
Dim destWs As Worksheet
Dim lastRow As Long
Dim pasteRow As Long
Dim pc As PivotCache
Dim pt As PivotTable
' 統合先シートを指定（このブックの「Master」シート）
Set destWs = ThisWorkbook.Sheets("Master")
destWs.Cells.Clear
pasteRow = 2
' 見出しを作成
destWs.Range("A1").Value = "ブック名"
destWs.Range("B1").Value = "商品"
destWs.Range("C1").Value = "数量"
destWs.Range("D1").Value = "金額"
' 各ブックからデータを統合
For Each wb In Application.Workbooks
If wb.Name <> ThisWorkbook.Name Then
For Each ws In wb.Worksheets
' 条件：シート名が「Data」
If ws.Name = "Data" Then
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
ws.Range("A2:D" & lastRow).Copy destWs.Range("B" & pasteRow)
' ブック名をA列に追加
destWs.Range("A" & pasteRow & ":A" & (pasteRow + lastRow - 2)).Value = wb.Name
pasteRow = destWs.Cells(destWs.Rows.Count, "A").End(xlUp).Row + 1
End If
Next ws
End If
Next wb
' ピボットキャッシュ作成
Set pc = ThisWorkbook.PivotCaches.Create( _
SourceType:=xlDatabase, _
SourceData:=destWs.Range("A1:D" & pasteRow - 1))
' 新しいシートにピボットテーブル作成
On Error Resume Next
Worksheets("PivotResult").Delete
On Error GoTo 0
Worksheets.Add.Name = "PivotResult"
Set pt = pc.CreatePivotTable( _
TableDestination:=Worksheets("PivotResult").Range("A3"), _
TableName:="統合ピボット")
' フィールド設定
With pt
.PivotFields("商品").Orientation = xlRowField
.PivotFields("ブック名").Orientation = xlColumnField
.PivotFields("数量").Orientation = xlDataField
.PivotFields("金額").Orientation = xlDataField
End With
End Sub
👉 開いているすべてのブックから「Data」シートのデータを統合し、商品別・ブック別に数量と金額を集計するピボットテーブルを新規作成します。
応用例1：セルの値で判定してピボット作成
Sub セル値でピボット新規作成()
Dim wb As Workbook
Dim ws As Worksheet
Dim destWs As Worksheet
Dim lastRow As Long
Dim pasteRow As Long
Dim pc As PivotCache
Dim pt As PivotTable
Set destWs = ThisWorkbook.Sheets("Master")
destWs.Cells.Clear
pasteRow = 2
destWs.Range("A1").Value = "ブック名"
destWs.Range("B1").Value = "カテゴリ"
destWs.Range("C1").Value = "売上"
For Each wb In Application.Workbooks
If wb.Name <> ThisWorkbook.Name Then
For Each ws In wb.Worksheets
' A1セルが「統合」と書かれていたら対象
If ws.Range("A1").Value = "統合" Then
lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
ws.Range("B2:C" & lastRow).Copy destWs.Range("B" & pasteRow)
destWs.Range("A" & pasteRow & ":A" & (pasteRow + lastRow - 2)).Value = wb.Name
pasteRow = destWs.Cells(destWs.Rows.Count, "B").End(xlUp).Row + 1
End If
Next ws
End If
Next wb
' ピボット作成
Set pc = ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
SourceData:=destWs.Range("A1:C" & pasteRow - 1))
Worksheets.Add.Name = "PivotByCategory"
Set pt = pc.CreatePivotTable(TableDestination:=Worksheets("PivotByCategory").Range("A3"))
With pt
.PivotFields("カテゴリ").Orientation = xlRowField
.PivotFields("ブック名").Orientation = xlColumnField
.PivotFields("売上").Orientation = xlDataField
End With
End Sub
ポイント
- 統合データを作る → まず「Master」シートに条件付きでデータを集める
- ピボットキャッシュ作成 →
PivotCaches.Create - ピボットテーブル新規作成 →
pc.CreatePivotTable - フィールド設定 →
.PivotFields("列名").Orientation = xlRowField / xlColumnField / xlDataField
練習課題
- 全ブックの「Sheet2」の売上データを統合し、商品別売上をピボットでまとめる
- 各シートのC1セルが「集計」と書かれていたら対象にして、地域別平均をピボット化する
- 複数条件を組み合わせて「シート名がReportで始まり、A1セルが空でないならSUM、空ならAVERAGE」をピボットでまとめる
こうした仕組みを作ると、複数ブックにまたがって条件付きでピボットテーブルを新規作成する自動化ツールが完成します。
