【Excel VBA】ピボットテーブルを作成するマクロ

マクロを使ってピボットテーブルを作りたい！という要望があったので、VBAでピボットテーブルを作成するマクロを作りました。

ピボットテーブルを作成するマクロ

ピボットテーブルを作成するマクロ

マクロを作成する前に、ピボットテーブルを作るためのデータを用意します。

1. 準備

Excelの1シート目に、ピボットテーブルを作るためのデータを設定します。ソースコードをそのまま使用する場合には、B2, C2, D2は以下と同じ文字にしておく必要があります。

下の表をコピーして、B2セルに貼り付ければ、上の図と同じシートが作れます。

サンプルデータ

日付	カテゴリ	代金
2020/1/3	食費	1,200
2020/1/19	服	3,000
2020/1/28	日用品	500
2020/2/19	食費	2,600
2020/2/25	交通費	900
2020/3/9	日用品	1,000

2. VBAのソースコードを書く

Module1を追加したら、以下のソースコードをコピぺしましょう。処理内容はソースのコメントに書いてあります。

ソースコードのポイント

①でピボットテーブルに使用するデータを選択します
②でピボットテーブルを表示する場所を設定します
③では①で選択したデータのヘッダーの文字を使用します
- ③(a)でピボットテーブルの列を設定します
- ③(b)でピボットテーブルの行を設定します
- ③(c)でピボットテーブルに表示する値を設定します

たけのこ

【2.準備】で用意したデータを変えるときには、ソースコードも同じように変更してください！例えば、【2.準備】の”日付”を”日時”に変えるときには、ソースコード内の”日付”も”日時”に変えてください。

copyを押してソース全体をコピーします。

copy

' ピボットテーブルを作成するマクロ
Sub CreatePivotTable()

    Dim pc As PivotCache
    Dim pt As PivotTable
    
    ' ①ピボットテーブルに使うデータを設定
    Set pc = ActiveWorkbook.PivotCaches.Create( _
                                SourceType:=xlDatabase, _
                                SourceData:=Worksheets(1).Range("B2").CurrentRegion)
    
    ' ピボットテーブル用の新規シートを作成
    Call DeleteSheet("ピボットテーブル")
    Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = "ピボットテーブル"
    
    ' ②ピボットテーブルを作成する
    Set pt = pc.CreatePivotTable( _
                                TableDestination:=Worksheets("ピボットテーブル").Range("B2"), _
                                TableName:="ピボットテーブル1")
    
    ' ③ピボットテーブルの詳細を設定する
    With pt
    
        ' (a)列ラベルに設定するデータ
        .PivotFields("カテゴリ").Orientation = xlColumnField
        
        ' (b)行ラベルに設定するデータ
        .PivotFields("日付").Orientation = xlRowField
        .PivotFields("日付").AutoGroup
        
        ' (c)表に設定するデータ
        .AddDataField .PivotFields("代金"), "家計簿", xlSum
    
    End With
    
End Sub

' シートを削除する
Sub DeleteSheet(ByVal sheetName As String)

    Dim ws As Worksheet
    For Each ws In Worksheets
    
        If ws.Name = sheetName Then
            
            ' "削除しますか？"の確認メッセージを非表示にする
            Application.DisplayAlerts = False
            
            ' "一覧"シートを削除する
            Worksheets(sheetName).Delete
            
            ' メッセージを表示する設定に戻す
            Application.DisplayAlerts = True
            
            ' 削除したら処理を終了する
            Exit Sub
            
        End If
    
    Next ws

End Sub