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

  1. Excel
  2. 2820 view

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

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

やりたいこと

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

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

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

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

  1. ピボットテーブルのオブジェクト宣言
  2. ピボットキャッシュにデータソースをセット
  3. Destinationオプションでピボットテーブルの位置を指定
  4. CreatePivotTableメソッドでピボットテーブル作成
  5. 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の最近記事

  1. 日本語をエンコードする【Excel VBA】

  2. 商品コードなど長い数値だけの文字列を指数表示させない【Excel VBA】

  3. VBAで改行を指定する【Excel】

  4. 入力規則のプルダウン連携【Excel】

  5. 最短手順で計算式を保護する【Excel】

関連記事

コメント

  1. この記事へのコメントはありません。

  1. この記事へのトラックバックはありません。

CAPTCHA


お薦め書籍

最近の記事

  1. Access

    Accessの数値型ではまる・・・。
  2. Excel

    日本語をエンコードする【Excel VBA】
  3. Access

    クエリで日付から曜日を算出する。【Access】
  4. PCパーツ

    ASUS AMD Ryzen 4000 シリーズ搭載小型ベア…
  5. Microsoft365

    コンデジをTeamsのWebカメラに使う
  6. SQL Server

    SQL文で今日から7日前までを指定する