【VBAリファレンス】エクセル関数応用ピポットテーブルの参照範囲を、追加・削除に自動対応で作成

スポンサーリンク

概要

Excelのピボットテーブルは、大量のデータを集計・分析するための強力なツールです。しかし、元データの範囲が変動する場合、ピボットテーブルの参照範囲を手動で更新する必要があり、これが手間となり、時には更新漏れによる誤った分析結果を招く原因にもなりかねません。本記事では、Excel VBAを活用し、ピボットテーブルの参照範囲を、元データの追加・削除に自動で対応させる方法を、詳細な解説とサンプルコードを交えてご紹介します。これにより、データ更新の手間を大幅に削減し、常に最新のデータに基づいた正確な分析を可能にします。

詳細解説

ピボットテーブルの参照範囲を自動化する鍵は、元データの範囲を動的に取得し、それをピボットテーブルのソースデータとして設定することにあります。これを実現するために、VBAでは以下のステップを踏みます。

1. 元データの範囲を特定する

元データの範囲を特定する方法はいくつかありますが、最も一般的で柔軟性の高いのは、特定のシート上の「使用されている最終セル」を基準に範囲を決定する方法です。`Cells(Rows.Count, 1).End(xlUp)` は、A列の最終行から上に移動して最初に見つかったセルを取得します。同様に `Cells(1, Columns.Count).End(xlToLeft)` は、1行目の最終列から左に移動して最初に見つかったセルを取得します。これらの組み合わせにより、データが存在する範囲を正確に特定できます。

例えば、`Sheet1` にデータがある場合、以下のコードでデータ範囲の左上セルと右下セルを取得できます。

Dim wsData As Worksheet
Dim lastRow As Long
Dim lastCol As Long
Dim dataRange As Range

Set wsData = ThisWorkbook.Sheets(“Sheet1”) ‘ 元データのあるシート名を指定

lastRow = wsData.Cells(wsData.Rows.Count, 1).End(xlUp).Row ‘ A列の最終行を取得
lastCol = wsData.Cells(1, wsData.Columns.Count).End(xlToLeft).Column ‘ 1行目の最終列を取得

Set dataRange = wsData.Range(wsData.Cells(1, 1), wsData.Cells(lastRow, lastCol))

この `dataRange` オブジェクトが、ピボットテーブルのソースデータとして使用する範囲となります。

2. ピボットテーブルを作成または更新する

既存のピボットテーブルの参照範囲を更新する場合と、新規にピボットテーブルを作成する場合で、VBAコードは若干異なります。

2.1. 既存のピボットテーブルの参照範囲を更新する

既に存在するピボットテーブルの参照範囲を更新するには、まず対象のピボットテーブルオブジェクトを取得する必要があります。ピボットテーブルは `PivotTables` コレクションに格納されています。

Dim pt As PivotTable
Dim wsPivot As Worksheet

Set wsPivot = ThisWorkbook.Sheets(“PivotSheet”) ‘ ピボットテーブルのあるシート名を指定

‘ シート上の最初のピボットテーブルを取得する場合
Set pt = wsPivot.PivotTables(1)

‘ ピボットテーブル名を指定して取得する場合
‘ Set pt = wsPivot.PivotTables(“ピボットテーブル名”)

‘ 参照範囲を更新
pt.ChangePivotCache ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=dataRange)

`ChangePivotCache` メソッドは、ピボットテーブルのデータソースを変更します。ここで、`ThisWorkbook.PivotCaches.Create` を使用して、新しいデータ範囲を指定したピボットキャッシュを作成し、それをピボットテーブルに適用します。

2.2. 新規にピボットテーブルを作成する

新規にピボットテーブルを作成する場合は、`PivotCaches.Create` でピボットキャッシュを作成した後、`PivotTableWizard` メソッドや `Add` メソッドを使用してピボットテーブルを配置します。

Dim pt As PivotTable
Dim wsPivot As Worksheet
Dim pc As PivotCache

Set wsPivot = ThisWorkbook.Sheets(“PivotSheet”) ‘ ピボットテーブルを作成するシート名を指定

‘ ピボットキャッシュを作成
Set pc = ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=dataRange)

‘ 新しいピボットテーブルを作成
Set pt = pc.CreatePivotTable(TableDestination:=wsPivot.Range(“A3″), TableName:=”MyNewPivotTable”)

‘ ここでピボットテーブルのフィールド設定などを記述
‘ 例: pt.PivotFields(“商品名”).Orientation = xlRowField
‘ pt.PivotFields(“売上”).Orientation = xlDataField

`CreatePivotTable` メソッドの `TableDestination` 引数で、ピボットテーブルを配置する開始セルを指定します。

3. 自動実行の設定

このVBAコードを、元データが変更された際に自動的に実行されるように設定することで、ピボットテーブルの参照範囲を常に最新の状態に保つことができます。自動実行の方法としては、以下の2つが考えられます。

3.1. ワークシートのイベントプロシージャを使用する

元データが存在するワークシートの `Change` イベントを利用する方法です。データが変更された際に自動的にコードが実行されます。

‘ 元データのあるシートモジュールに記述
Private Sub Worksheet_Change(ByVal Target As Range)
‘ データ範囲の変更を検知した場合にピボットテーブル更新処理を実行
‘ 例: 特定のセル範囲が変更されたら実行するなどの条件分岐を入れることも可能
Call UpdatePivotTable
End Sub

`UpdatePivotTable` は、上記で説明したピボットテーブル更新処理を記述した標準モジュール内のサブルーチンとします。`Target` 引数で変更されたセル範囲を取得できるため、必要に応じて特定の範囲の変更のみをトリガーとするなどの制御が可能です。

3.2. ワークブックのイベントプロシージャを使用する

ワークブックが開かれた際に、最新のデータ範囲でピボットテーブルを更新する方法です。

‘ ThisWorkbook モジュールに記述
Private Sub Workbook_Open()
Call UpdatePivotTable
End Sub

この方法では、ワークブックを開くたびにピボットテーブルが更新されます。

4. コードの構造化とエラーハンドリング

実際の運用では、コードを標準モジュールにまとめて、呼び出しやすいようにすることが推奨されます。また、予期せぬエラー(シートが存在しない、ピボットテーブルが見つからないなど)が発生した場合に、処理が中断しないようにエラーハンドリングを実装することが重要です。

Sub UpdatePivotTable()
On Error GoTo ErrorHandler

Dim wsData As Worksheet
Dim wsPivot As Worksheet
Dim lastRow As Long
Dim lastCol As Long
Dim dataRange As Range
Dim pt As PivotTable
Dim pc As PivotCache

‘ — 設定 —
Const DATA_SHEET_NAME As String = “Sheet1” ‘ 元データのあるシート名
Const PIVOT_SHEET_NAME As String = “PivotSheet” ‘ ピボットテーブルのあるシート名
Const PIVOT_TABLE_NAME As String = “MyPivotTable” ‘ 更新するピボットテーブル名 (新規作成の場合は不要)
‘ — 設定ここまで —

‘ 各シートオブジェクトを設定
On Error Resume Next ‘ シートが存在しない場合のエラーを一旦無視
Set wsData = ThisWorkbook.Sheets(DATA_SHEET_NAME)
Set wsPivot = ThisWorkbook.Sheets(PIVOT_SHEET_NAME)
On Error GoTo ErrorHandler ‘ エラーハンドリングを元に戻す

‘ シートが存在しない場合は処理を終了
If wsData Is Nothing Then
MsgBox DATA_SHEET_NAME & ” シートが見つかりません。”, vbCritical
Exit Sub
End If
If wsPivot Is Nothing Then
MsgBox PIVOT_SHEET_NAME & “シートが見つかりません。”, vbCritical
Exit Sub
End If

‘ 元データの最終行と最終列を取得
lastRow = wsData.Cells(wsData.Rows.Count, 1).End(xlUp).Row
lastCol = wsData.Cells(1, wsData.Columns.Count).End(xlToLeft).Column

‘ データ範囲を設定 (ヘッダー行を含む)
‘ データがない場合(例: ヘッダー行のみ)も考慮
If lastRow < 1 Then lastRow = 1 If lastCol < 1 Then lastCol = 1 Set dataRange = wsData.Range(wsData.Cells(1, 1), wsData.Cells(lastRow, lastCol)) ' 既存のピボットテーブルを更新 On Error Resume Next ' ピボットテーブルが存在しない場合のエラーを一旦無視 Set pt = wsPivot.PivotTables(PIVOT_TABLE_NAME) On Error GoTo ErrorHandler ' エラーハンドリングを元に戻す If pt Is Nothing Then ' ピボットテーブルが存在しない場合は新規作成 MsgBox PIVOT_TABLE_NAME & "が見つかりません。新規作成します。", vbInformation Set pc = ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=dataRange) Set pt = pc.CreatePivotTable(TableDestination:=wsPivot.Range("A3"), TableName:=PIVOT_TABLE_NAME) ' ここで新規作成したピボットテーブルのフィールド設定を記述 ' 例: ' With pt ' .PivotFields("商品名").Orientation = xlRowField ' .PivotFields("売上").Orientation = xlDataField ' .DataBodyRange.NumberFormat = "#,##0" ' End With Else ' 既存のピボットテーブルの参照範囲を更新 Set pc = ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=dataRange) pt.ChangePivotCache pc pt.RefreshTable ' データの更新も行う End If MsgBox "ピボットテーブルの参照範囲が更新されました。", vbInformation Exit Sub ' 正常終了 ErrorHandler: MsgBox "エラーが発生しました。" & vbCrLf & _ "エラー番号: " & Err.Number & vbCrLf & _ "エラー内容: " & Err.Description, vbCritical ' 必要に応じてエラー発生時の後処理を記述 End Sub このサンプルコードは、指定したシートのデータ範囲を自動的に取得し、指定した名前のピボットテーブルが存在すればその参照範囲を更新し、存在しなければ新規に作成する処理を含んでいます。`Const` でシート名やピボットテーブル名を定数として定義することで、後からの変更が容易になります。

サンプルコード

以下に、上記解説を基にしたVBAサンプルコードを示します。このコードは、標準モジュールに記述し、`UpdatePivotTable` という名前で保存することを想定しています。

‘================================================================================
‘ モジュール名: PivotUpdateModule
‘ 説明: ピボットテーブルの参照範囲を元データの追加・削除に自動対応させるためのVBAコード
‘================================================================================

Option Explicit

‘ — 設定項目 —
‘ 元データが存在するシートの名前
Const DATA_SHEET_NAME As String = “売上データ”
‘ ピボットテーブルを作成または更新するシートの名前
Const PIVOT_SHEET_NAME As String = “分析レポート”
‘ 作成または更新するピボットテーブルの名前
Const PIVOT_TABLE_NAME As String = “月別売上分析”
‘ ピボットテーブルを新規作成する場合の開始セル (例: “A3”)
Const PIVOT_START_CELL As String = “A3″
‘ — 設定項目ここまで —

Sub UpdatePivotTableSource()
‘============================================================================
‘ 関数名: UpdatePivotTableSource
‘ 説明: 指定された元データ範囲に基づいて、ピボットテーブルのソースデータを
‘ 更新または新規作成します。
‘ 引数: なし
‘ 戻り値: なし
‘ 備考: エラーハンドリングを含みます。
‘============================================================================
On Error GoTo ErrorHandler

Dim wsData As Worksheet
Dim wsPivot As Worksheet
Dim lastRow As Long
Dim lastCol As Long
Dim dataRange As Range
Dim pt As PivotTable
Dim pc As PivotCache
Dim pivotDestination As Range

‘ — 1. シートオブジェクトの設定 —
‘ 元データシートの存在確認
On Error Resume Next ‘ シートが見つからない場合のエラーを一時的に無視
Set wsData = ThisWorkbook.Sheets(DATA_SHEET_NAME)
On Error GoTo ErrorHandler ‘ エラーハンドリングを元に戻す

If wsData Is Nothing Then
MsgBox DATA_SHEET_NAME & ” シートが見つかりません。処理を中断します。”, vbCritical, “エラー”
Exit Sub
End If

‘ ピボットシートの存在確認
On Error Resume Next
Set wsPivot = ThisWorkbook.Sheets(PIVOT_SHEET_NAME)
On Error GoTo ErrorHandler

If wsPivot Is Nothing Then
MsgBox PIVOT_SHEET_NAME & “シートが見つかりません。処理を中断します。”, vbCritical, “エラー”
Exit Sub
End If

‘ — 2. 元データの範囲特定 —
‘ データ範囲の最終行をA列から取得
lastRow = wsData.Cells(wsData.Rows.Count, 1).End(xlUp).Row
‘ データ範囲の最終列を1行目から取得
lastCol = wsData.Cells(1, wsData.Columns.Count).End(xlToLeft).Column

‘ データが存在しない(ヘッダー行のみなど)場合も考慮し、最小範囲を設定
If lastRow < 1 Then lastRow = 1 If lastCol < 1 Then lastCol = 1 ' データ範囲を設定 (A1セルから最終行・最終列まで) Set dataRange = wsData.Range(wsData.Cells(1, 1), wsData.Cells(lastRow, lastCol)) ' データ範囲がヘッダー行のみ、または空の場合のチェック If dataRange.Rows.Count <= 1 And dataRange.Cells.Count <= wsData.Cells(1, wsData.Columns.Count).Column Then ' ヘッダー行のみ、またはデータがほとんどない場合 ' 必要に応じて、この場合の処理を記述。ここでは警告メッセージを表示して終了。 ' MsgBox "元データに十分なデータが含まれていないため、ピボットテーブルの更新をスキップします。", vbInformation, "情報" ' Exit Sub ' ただし、ヘッダーのみでもピボットテーブルは作成できるため、ここでは処理を続行する。 End If ' --- 3. ピボットテーブルの処理 --- ' 既存のピボットテーブルオブジェクトを取得 On Error Resume Next Set pt = wsPivot.PivotTables(PIVOT_TABLE_NAME) On Error GoTo ErrorHandler ' ピボットテーブルが存在しない場合 If pt Is Nothing Then ' --- 3a. 新規ピボットテーブルの作成 --- MsgBox PIVOT_TABLE_NAME & " が見つかりません。新しく作成します。", vbInformation, "情報" ' ピボットキャッシュを作成 Set pc = ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=dataRange) ' ピボットテーブルを配置するセルを指定 Set pivotDestination = wsPivot.Range(PIVOT_START_CELL) ' ピボットテーブルを作成 Set pt = pc.CreatePivotTable(TableDestination:=pivotDestination, TableName:=PIVOT_TABLE_NAME) ' --- ★★★ ここに新規ピボットテーブルのフィールド設定などを記述 ★★★ --- ' 例: 商品名を行フィールド、売上をデータフィールドに設定する場合 With pt ' フィールド名が実際のヘッダーと一致しているか確認してください On Error Resume Next ' フィールドが存在しない場合のエラーを回避 .PivotFields("商品名").Orientation = xlRowField .PivotFields("商品名").Position = 1 ' 最初の行フィールド .PivotFields("月").Orientation = xlColumnField .PivotFields("月").Position = 1 ' 最初の列フィールド .PivotFields("売上").Orientation = xlDataField .PivotFields("売上").Function = xlSum ' 集計方法を合計に設定 .PivotFields("売上").NumberFormat = "#,##0" ' 数値フォーマットを設定 .PivotFields("売上").Name = "合計売上" ' データフィールドの名前を変更 On Error GoTo ErrorHandler End With ' --- ★★★ フィールド設定ここまで ★★★ --- MsgBox PIVOT_TABLE_NAME & " を新しく作成しました。", vbInformation, "完了" Else ' --- 3b. 既存ピボットテーブルのソースデータ更新 --- MsgBox PIVOT_TABLE_NAME & " が見つかりました。ソースデータを更新します。", vbInformation, "情報" ' 新しいピボットキャッシュを作成 Set pc = ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=dataRange) ' ピボットテーブルのキャッシュを変更 pt.ChangePivotCache pc ' ピボットテーブルを再集計 (データの更新) pt.RefreshTable MsgBox PIVOT_

タイトルとURLをコピーしました