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

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