Excel VBA 逆引き集 | 実務テンプレ完全版（超再利用部品） – ピボット自動生成テンプレ

Excel VBA
スポンサーリンク

ねらい：明細から「ピボットを自動生成→更新→見える化」まで一括で回す

ピボットは「行・列・値・フィルター」を正しく指定すれば、集計や比較を数秒で作れます。VBAなら“ソース表を認識→ピボットを作成→フィールドを配置→書式・レイアウトを適用→更新を自動化”の型にすると、列追加やデータ増にも壊れずに対応できます。初心者でも貼って動くテンプレを、例題付きでかみ砕いて解説します。

入力仕様と基本設計：ソース表を確実に掴む

ソース表の条件と推奨構成

  • ソースは1行目がヘッダ、2行目からデータの「縦持ち明細」。
  • 欄は「キー（顧客・商品・日付）」「指標（数量・金額）」が明確に分かれている。
  • データ範囲はテーブル（ListObject）化すると列追加に強く、更新が楽。

重要ポイントの深掘り

ピボットは「縦持ちの明細」から作るのが鉄則です。1行目ヘッダ固定にするとフィールド名が安定し、VBAでの指定ズレがなくなります。Excelのテーブル（Ctrl+T）にしておけば、行や列を追加しても範囲指定が自動で広がり、ピボットの更新が壊れません。

共通基盤：ソース範囲取得・ピボット作成ユーティリティ

ユーティリティモジュール（貼って動く）

' ModPivot_Base.bas
Option Explicit

Public Function GetSourceRange(ByVal wsName As String, Optional ByVal topLeft As String = "A1") As Range
    Dim ws As Worksheet: Set ws = Worksheets(wsName)
    ' テーブルがあればテーブル範囲、なければ CurrentRegion
    If ws.ListObjects.Count > 0 Then
        Set GetSourceRange = ws.ListObjects(1).DataBodyRange.Offset(-1, 0).Resize(ws.ListObjects(1).DataBodyRange.Rows.Count + 1)
    Else
        Set GetSourceRange = ws.Range(topLeft).CurrentRegion
    End If
End Function

Public Function PrepareOutSheet(ByVal name As String) As Worksheet
    Dim ws As Worksheet
    On Error Resume Next: Set ws = Worksheets(name): On Error GoTo 0
    If ws Is Nothing Then Set ws = Worksheets.Add: ws.Name = name
    ws.Cells.Clear
    Set PrepareOutSheet = ws
End Function

Public Sub AutoFitBorders(ByVal rng As Range)
    With rng
        .Columns.AutoFit
        .Borders.LineStyle = xlContinuous
    End With
End Sub
VB

重要ポイントの深掘り

テーブル優先で範囲取得する設計にすると、列追加・データ増で壊れません。CurrentRegionはシンプルですが、空列が混ざると途切れるので、基本はテーブル化を推奨します。

ピボット自動生成：行・列・値・フィルターを指定して一発作成

1枚のシートに基本ピボットを生成するテンプレ

' ModPivot_Generate.bas
Option Explicit

Public Sub CreateBasicPivot(ByVal srcSheet As String, ByVal outSheet As String, _
                            ByVal rowField As String, ByVal colField As String, _
                            ByVal valueField As String, Optional ByVal aggFunc As XlConsolidationFunction = xlSum, _
                            Optional ByVal filterField As String = "", Optional ByVal reportFilterValue As Variant = Empty)
    Dim srcRng As Range: Set srcRng = GetSourceRange(srcSheet)
    Dim wsOut As Worksheet: Set wsOut = PrepareOutSheet(outSheet)

    Dim pc As PivotCache
    Set pc = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=srcRng)

    Dim pt As PivotTable
    Set pt = pc.CreatePivotTable(TableDestination:=wsOut.Range("A3"), TableName:="Pivot_" & outSheet)

    With pt
        .RowGrand = True
        .ColumnGrand = True
        .HasAutoFormat = False
        .RepeatAllLabels xlRepeatLabels
        .RowAxisLayout xlTabularRow ' 行ラベルの見出しを繰り返しやすいレイアウト
    End With

    If Len(rowField) > 0 Then pt.PivotFields(rowField).Orientation = xlRowField
    If Len(colField) > 0 Then pt.PivotFields(colField).Orientation = xlColumnField

    With pt.PivotFields(valueField)
        .Orientation = xlDataField
        .Function = aggFunc
        .NumberFormat = "#,##0"
        .Name = valueField & IIf(aggFunc = xlSum, "_合計", "")
    End With

    If Len(filterField) > 0 Then
        pt.PivotFields(filterField).Orientation = xlPageField
        If Not IsEmpty(reportFilterValue) Then
            pt.PivotFields(filterField).CurrentPage = reportFilterValue
        End If
    End If

    wsOut.Range("A1").Value = "ピボット: " & rowField & " × " & colField & " (" & valueField & ")"
    AutoFitBorders wsOut.UsedRange
End Sub
VB

重要ポイントの深掘り

  • 行・列・値・フィルターを文字名で指定し、列順が変わっても壊れないようにします。
  • レイアウトは“タブ形式（xlTabularRow）”で行見出しを繰り返し表示にして、CSV出力や二次利用がしやすくします。
  • 値の書式は“#,##0”の基本書式に固定。指標が金額なら必要に応じて通貨書式へ切替できます。

集約パターン拡張：件数・平均・ユニーク件数・複数値フィールド

よく使う集約の追加配置

' ModPivot_AggPatterns.bas
Option Explicit

Public Sub AddCountField(ByVal pt As PivotTable, ByVal fieldName As String)
    With pt.PivotFields(fieldName)
        .Orientation = xlDataField
        .Function = xlCount
        .NumberFormat = "0"
        .Name = fieldName & "_件数"
    End With
End Sub

Public Sub AddAverageField(ByVal pt As PivotTable, ByVal fieldName As String)
    With pt.PivotFields(fieldName)
        .Orientation = xlDataField
        .Function = xlAverage
        .NumberFormat = "#,##0.0"
        .Name = fieldName & "_平均"
    End With
End Sub

Public Sub AddDistinctCountField(ByVal pt As PivotTable, ByVal fieldName As String)
    ' 注: Distinct Count はデータモデル（OLAP）経由が必要。簡易代替は「集計元をユニーク化して Count」。
    On Error Resume Next
    With pt.PivotFields(fieldName)
        .Orientation = xlDataField
        .Function = xlDistinctCount ' バージョン・接続条件で不可の場合あり
        .Name = fieldName & "_ユニーク件数"
    End With
    On Error GoTo 0
End Sub
VB

重要ポイントの深掘り

複数の値フィールドを並べると、ピボットの「値」エリアに“合計／件数／平均”を同時表示できます。Distinct Countは環境依存なので、まずは「集計前にユニーク化したテーブルを作る」代替案を使うと安定します。

見える化の仕上げ：並べ替え・トップN・スライサー・更新

便利操作の自動化テンプレ

' ModPivot_View.bas
Option Explicit

Public Sub SortByValueDesc(ByVal pt As PivotTable, ByVal rowField As String, ByVal dataFieldCaption As String)
    pt.PivotFields(rowField).AutoSort xlDescending, dataFieldCaption, pt.TableRange1
End Sub

Public Sub ApplyTopNFilter(ByVal pt As PivotTable, ByVal rowField As String, ByVal dataFieldCaption As String, ByVal topN As Long)
    With pt.PivotFields(rowField)
        .EnableMultiplePageItems = True
        .PivotFilters.Add Type:=xlTopCount, DataField:=pt.DataFields(dataFieldCaption), Value1:=topN
    End With
End Sub

Public Sub AddSlicer(ByVal pt As PivotTable, ByVal fieldName As String, ByVal left As Double, ByVal top As Double)
    Dim sc As SlicerCache
    Set sc = ActiveWorkbook.SlicerCaches.Add(pt, fieldName)
    sc.Slicers.Add SlicerDestination:=pt.Parent, Left:=left, Top:=top, Height:=120, Width:=160
End Sub

Public Sub RefreshPivot(ByVal outSheet As String)
    Dim ws As Worksheet: Set ws = Worksheets(outSheet)
    Dim pt As PivotTable
    For Each pt In ws.PivotTables
        pt.PivotCache.Refresh
        pt.RefreshTable
    Next
End Sub
VB

重要ポイントの深掘り

  • 値降順の自動並べ替えとトップNフィルターで、重要な項目に一瞬でフォーカスできます。
  • スライサーは現場が好むインタラクティブなフィルター。フィールドを指定して追加すると、クリックだけで絞り込みが可能。
  • 更新は「PivotCache.Refresh→RefreshTable」を一括実行で安定。データ差し替え直後でも壊れません。

例題の通し方：売上明細から「商品×月の合計」「顧客別合計＋件数」を自動生成

データ前提

Detail（明細）シートに A=注文日、B=顧客、C=商品、D=数量、E=金額 の縦持ちテーブルがあるとします。

実行例コード

' ModPivot_Example.bas
Option Explicit

Public Sub Demo_PivotPipeline()
    ' 1) 商品×月の合計金額ピボットを作成
    CreateBasicPivot srcSheet:="Detail", outSheet:="Pivot_MonthProduct", _
                     rowField:="商品", colField:="注文日", valueField:="金額", aggFunc:=xlSum
    ' 列フィールド（日付）を「月」にグループ化（手動または事前に年月列を用意）
    GroupDateByMonth Worksheets("Pivot_MonthProduct").PivotTables(1), "注文日"

    ' 2) 顧客別の合計金額＋件数ピボットを作成
    CreateBasicPivot srcSheet:="Detail", outSheet:="Pivot_Customer", _
                     rowField:="顧客", colField:="", valueField:="金額", aggFunc:=xlSum
    Dim pt As PivotTable: Set pt = Worksheets("Pivot_Customer").PivotTables(1)
    AddCountField pt, "金額" ' 明細件数の代替（行数）として金額の件数を追加
    SortByValueDesc pt, "顧客", "金額_合計"
    RefreshPivot "Pivot_Customer"

    MsgBox "ピボットの自動生成が完了しました。", vbInformation
End Sub

Private Sub GroupDateByMonth(ByVal pt As PivotTable, ByVal dateFieldName As String)
    On Error Resume Next
    With pt.PivotFields(dateFieldName)
        .PivotItems(1).ShowDetail = True ' 既存グループ解除のためのダミー操作
        .Parent.PivotCache.MissingItemsLimit = xlMissingItemsNone
        .Parent.ManualUpdate = True
        .Grouping GroupStart:=True, GroupEnd:=True, By:=Array(1, 2, 3, 4, 5, 6, 7)
        ' 注: Groupingの引数は環境依存・複雑なので、実務は「年月列」を先に作る方が安定
    End With
    On Error GoTo 0
End Sub
VB

重要ポイントの深掘り

  • 日付グループ化はExcelのUI依存が強く、コードで不安定になりがちです。実務では「年月列（yyyy-mm）を事前派生」して、それを列フィールドにするのが最も安定します。
  • 件数は「金額のCount」などで代替できますが、明細行数の正確な件数が欲しい場合は“ID列のCount”を使うとよいです。

落とし穴と対策：日付グループ化・範囲ズレ・フィールド名変更

よくある破綻ポイントと対処

  • 日付のグループ化が失敗して列が崩れる
    事前に「年月」派生列を持たせる。日付そのものを列フィールドにせず、文字列の年月で列を作る方が安定。
  • 範囲が広がらず新しい行が反映されない
    ソースをテーブル（ListObject）化し、GetSourceRangeでテーブル範囲を返す設計にする。CurrentRegion前提は空列で途切れるので注意。
  • フィールド名が変わってコードがエラー
    行・列・値・フィルターを“文字列名”で指定し、ヘッダ名を運用で固定。変更時は引数の文字列だけ差し替え。
  • 表示が見づらい（小計位置・レイアウト）
    行ラベルのレイアウトを“タブ形式”に変更し、見出しの繰り返しを有効化。数値書式は“#,##0”で統一し、AutoFit＋罫線を最後に当てる。

まとめ：範囲を正しく掴み、フィールドを文字で指定し、レイアウトを固定する

ソースはテーブルで安定取得、行・列・値・フィルターは文字名指定、レイアウトはタブ形式、値は一括書式。グループ化は年月の派生列で代替すれば堅牢です。

スポンサーリンク
タイトルとURLをコピーしました