ピボットテーブル【Excel VBA】

Excel
2966 view

ピボットテーブル【Excel VBA】

データベースで集計を行っているとピボットテーブルの様な「複雑なクロス集計」をしたい場合があります。昔はアクセスに「ピボットテーブルビュー」というのがあって便利だったのですが、いまは無くなったのでエクセルに取り込んで集計するしかありません。当記事では定型処理をVBAで自動化する手順をまとめます。

コンテンツ

1 やりたいこと
2 VBAでピボットテーブルを作成する手順
3 サンプルプログラム
4 まとめ

やりたいこと

今あるピボットテーブルを削除する
検索条件を付けてSQL Server からデータを呼び出す(← この部分は記事にはありません)
定型のピボットテーブルを作成する

ピボットテーブルを作成する手順を当記事でまとめて行きます

VBAでピボットテーブルを作成する手順

大くくりで言うと以下の手順に分割されます。

ピボットテーブルのオブジェクト宣言
ピボットキャッシュにデータソースをセット
Destinationオプションでピボットテーブルの位置を指定
CreatePivotTableメソッドでピボットテーブル作成
AddFieldsメソッドで行と列フィールドを追加

ピボットテーブルのオブジェクト宣言

Worksheetオブジェクト.PivotTables(ピボットテーブル名)

ピボットキャッシュにデータソースをセット

PivotCaches.Create(SourceType:=xlDatabase, SourceData:=データソースの範囲)

Destinationオプションでピボットテーブルの位置を指定しCreatePivotTableメソッドでピボットテーブル作成

PivotCacheオブジェクト.CreatePivotTable TableDestination:=位置指定, TableName:=ピボットテーブル名

AddFieldsメソッドで行と列フィールドを追加

PivotTableオブジェクト.AddFields ColumnFields:=Array(項目名), RowFields:= Array(項目名)

ここはマクロの記録を行ってそのままコピペしてしまいました。

PivotFieldオブジェクト

https://docs.microsoft.com/ja-jp/office/vba/api/excel.pivotfields
から探していくと分かりやすそうです。

サンプルプログラム

全てをVBAでと思いましたが、行と列の追加はマクロのコピペの方が開発効率が良さそうなので、ピボットテーブルを作るまでをVBA、行と列のフィールド追加をマクロを記述したものをコピペするという手順にしました。

実際に作成したプログラムは以下の通りです。

Sub ピボット集計_Click()


    '   変数宣言
    Dim i1, i2, i3 As Long      'カウンタ
    Dim WS_LIST As Worksheet 'シート「元データ」
    Dim WS_SYUKEI As Worksheet  'シート「ピボットテーブル」
    Dim PV_CACHE As PivotCache  'ピボットキャッシュ用変数
    Dim PV_TABLE As PivotTable  'ピボットテーブル

    '   シート宣言
    Set WS_LIST = Sheets("元データ")
    Set WS_SYUKEI = Sheets("ピボットテーブル")

    '   旧ピボットテーブル削除
    For Each PV_TABLE In WS_SYUKEI.PivotTables
        WS_SYUKEI.Range(PV_TABLE.TableRange2.Address).Delete Shift:=xlUp
    Next

    '   ピボットキャッシュ作成
    i1 = WS_LIST.Cells(Cells.Rows.Count, 2).End(xlUp).Row   'B列最終行
    
    Set PV_CACHE = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=WS_LIST.Range("B5:V" & i1))

    '   ピボットテーブル作成
    PV_CACHE.CreatePivotTable TableDestination:=WS_SYUKEI.Range("B2"), TableName:="工数集計"
    
    '   ピボットテーブルにフィールド追加 --- マクロをコピーここから ---
    Sheets("ピボットテーブル").Select
    Cells(1, 1).Select
    
    With ActiveSheet.PivotTables("工数集計")
        .ColumnGrand = True
        .HasAutoFormat = True
        .DisplayErrorString = False
        .DisplayNullString = True
        .EnableDrilldown = True
        .ErrorString = ""
        .MergeLabels = False
        .NullString = ""
        .PageFieldOrder = 2
        .PageFieldWrapCount = 0
        .PreserveFormatting = True
        .RowGrand = True
        .SaveData = True
        .PrintTitles = False
        .RepeatItemsOnEachPrintedPage = True
        .TotalsAnnotation = False
        .CompactRowIndent = 1
        .InGridDropZones = False
        .DisplayFieldCaptions = True
        .DisplayMemberPropertyTooltips = False
        .DisplayContextTooltips = True
        .ShowDrillIndicators = True
        .PrintDrillIndicators = False
        .AllowMultipleFilters = False
        .SortUsingCustomLists = True
        .FieldListSortAscending = False
        .ShowValuesRow = False
        .CalculatedMembersInFilters = False
        .RowAxisLayout xlCompactRow
    End With
    
    With ActiveSheet.PivotTables("工数集計").PivotCache
        .RefreshOnFileOpen = False
        .MissingItemsLimit = xlMissingItemsDefault
    End With
    
    ActiveSheet.PivotTables("工数集計").RepeatAllLabels xlRepeatLabels
    
    With ActiveSheet.PivotTables("工数集計")
        .InGridDropZones = True
        .RowAxisLayout xlTabularRow
    End With
    
    With ActiveSheet.PivotTables("工数集計").PivotFields("所属")
        .Orientation = xlRowField
        .Position = 1
    End With
    
    With ActiveSheet.PivotTables("工数集計").PivotFields("氏名")
        .Orientation = xlRowField
        .Position = 2
    End With
    
    With ActiveSheet.PivotTables("工数集計").PivotFields("業務" & Chr(10) & "分類")
        .Orientation = xlRowField
        .Position = 3
    End With
    
    With ActiveSheet.PivotTables("工数集計").PivotFields("工程")
        .Orientation = xlRowField
        .Position = 4
    End With
    
    With ActiveSheet.PivotTables("工数集計").PivotFields("機種")
        .Orientation = xlRowField
        .Position = 5
    End With
    
    With ActiveSheet.PivotTables("工数集計").PivotFields("年月")
        .Orientation = xlColumnField
        .Position = 1
    End With
    
    With ActiveSheet.PivotTables("工数集計").PivotFields("日")
        .Orientation = xlColumnField
        .Position = 2
    End With
    
    ActiveSheet.PivotTables("工数集計").AddDataField ActiveSheet.PivotTables( _
        "工数集計").PivotFields("工数"), "合計 / 工数", xlSum
    
    Range("A3").Select
    
    With ActiveSheet.PivotTables("工数集計").PivotFields("合計 / 工数")
        .NumberFormat = "#,##0_ "
    End With
    
    Range("D4").Select
    
    ActiveSheet.PivotTables("工数集計").PivotFields("工程").Subtotals = Array(False, _
        False, False, False, False, False, False, False, False, False, False, False)
    
    ActiveSheet.PivotTables("工数集計").PivotSelect "機種", xlButton, True

    ActiveSheet.PivotTables("工数集計").PivotFields("機種").Subtotals = Array(False, _
        False, False, False, False, False, False, False, False, False, False, False)

    ActiveSheet.PivotTables("工数集計").PivotSelect "氏名[All;Total]", _
        xlDataAndLabel, True
    
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 10079487
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    
    ActiveSheet.PivotTables("工数集計").PivotSelect "'業務" & Chr(10) & "分類'[All;Total]", _
        xlDataAndLabel, True
    
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 13434879
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    
    ActiveSheet.PivotTables("工数集計").RepeatAllLabels xlDoNotRepeatLabels

    ActiveSheet.PivotTables("工数集計").PivotSelect "日[All]", xlLabelOnly, True
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 10079487
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    
    Range("B4:F4").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 10079487
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With

    ActiveSheet.PivotTables("工数集計").PivotFields("業務" & Chr(10) & "分類").AutoSort xlDescending, _
        "業務" & Chr(10) & "分類"
    
    Cells.Select
    With Selection.Font
        .Name = "メイリオ"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    
    ActiveWorkbook.ShowPivotTableFieldList = False

    '   --- マクロをコピーここまで ---

    Range("A5").Select

End Sub

まとめ

ピボットテーブルの元になるシートと作成先のシートを宣言し、VBAで今あるピボットテーブルを削除し、新しいピボットテーブルを作るところまでをプログラミングで、行と列の追加はマクロのコピペという手段で実装を実現しました。

行と列の追加はマクロのコピペという手段を取ってしまったので、ポイントは「シートを指定して今あるピボットテーブルを削除する。」だけだと思います。
以下で実現しています。
‘ 旧ピボットテーブル削除
For Each PV_TABLE In WS_SYUKEI.PivotTables
WS_SYUKEI.Range(PV_TABLE.TableRange2.Address).Delete Shift:=xlUp
Next

投稿者: たかはし
Excel, VBA
コメント: 0

市販教材でエクセルの入門教育を行う事になりました【Excel】前の記事

スマホのバンパーケースを考える次の記事

小さい会社の1人SEの開発記というか奮戦記

1人SEの独り言