hiko-blog

VBA業務改善

MENU

作成するピボットテーブルが「現在のピボットテーブルの書式」または「従来のピボットテーブルの書式」のどちらであるかを選択

Sub CreatePivotTableWithPrompt()
    Dim ws As Worksheet
    Dim pt As PivotTable
    Dim pc As PivotCache
    Dim rngData As Range
    Dim rngDest As Range
    Dim response As VbMsgBoxResult

    ' データ範囲を指定します。適切に変更してください。
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Set rngData = ws.Range("A1:D100") ' データの範囲を指定

    ' ユーザーに確認メッセージを表示し、選択させます。
    response = MsgBox("どの書式でピボットテーブルを作成しますか?" & vbCrLf & _
                      "現在のピボットテーブルの書式: 「はい」を選択" & vbCrLf & _
                      "従来のピボットテーブルの書式: 「いいえ」を選択", vbYesNoCancel, "書式の選択")

    If response = vbCancel Then Exit Sub ' キャンセルが選択された場合、処理を終了します。

    ' ピボットテーブルを配置する場所を指定します。適切に変更してください。
    Set rngDest = ws.Range("F1")

    ' ピボットキャッシュを作成します。
    Set pc = ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=rngData)

    ' ピボットテーブルを作成します。
    If response = vbYes Then
        ' 現在のピボットテーブルの書式で作成
        Set pt = rngDest.PivotTableWizard(TableDestination:=rngDest, TableName:="PivotTable1", SourceType:=xlDatabase, SourceData:=rngData)
    ElseIf response = vbNo Then
        ' 従来のピボットテーブルの書式で作成
        Set pt = rngDest.PivotTableWizard(TableDestination:=rngDest, TableName:="PivotTable1", SourceType:=xlDatabase, SourceData:=rngData, DefaultVersion:=xlPivotTableVersion10)
    End If

    ' ピボットテーブルのフィールドを配置します。適切に変更してください。
    With pt
        .PivotFields("Field1").Orientation = xlRowField ' 行フィールドに配置
        .PivotFields("Field2").Orientation = xlColumnField ' 列フィールドに配置
        .PivotFields("Field3").Orientation = xlDataField ' データフィールドに配置
    End With
End Sub