VBAを使用してピボットテーブルを作成する方法

Question

私はVBAの初心者で、ExcelでVBAを使用してPivotTableを作成しようとしています。

入力シートとして以下のような画像を作成したいと思います。

region、month、number、statusの行ラベルを追加しようとしています。値はvalue1、value2とtotalここでは、ピボットの範囲を設定できますが、実行すると「ピボット可能」シートのみが作成されます。 sheet1のピボットテーブルを生成しません。

マイコード：

Option Explicit

Public Sub Input_File__1()

ThisWorkbook.Sheets(1).TextBox1.Text = Application.GetOpenFilename()

End Sub

'======================================================================

Public Sub Output_File_1()

Dim get_fldr, item As String
Dim fldr As FileDialog

Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
    .AllowMultiSelect = False
    If .Show <> -1 Then GoTo nextcode:

    item = .SelectedItems(1)
    If Right(item, 1) <> "\" Then
        item = item & "\"
    End If
End With

nextcode:
get_fldr = item
Set fldr = Nothing
ThisWorkbook.Worksheets(1).TextBox2.Text = get_fldr

End Sub

'======================================================================

Public Sub Process_start()

Dim Raw_Data_1, Output As String
Dim Raw_data, Start_Time As String
Dim PSheet As Worksheet
Dim DSheet As Worksheet
Dim PCache As PivotCache
Dim PTable As PivotTable
Dim PRange As Range
Dim LastRow As Long
Dim LastCol As Long

Start_Time = Time()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Raw_Data_1 = ThisWorkbook.Sheets(1).TextBox1.Text
Output = ThisWorkbook.Sheets(1).TextBox2.Text

Workbooks.Open Raw_Data_1: Set Raw_data = ActiveWorkbook
Raw_data.Sheets("Sheet1").Activate

On Error Resume Next

'Worksheets("Sheet1").Delete
Sheets.Add before:=ActiveSheet
ActiveSheet.Name = "Pivottable"

Application.DisplayAlerts = True

Set PSheet = Worksheets("Pivottable")
Set DSheet = Worksheets("Sheet1")
LastRow = DSheet.Cells(Rows.Count, 1).End(xlUp).Row
LastCol = DSheet.Cells(1, Columns.Count).End(xlToLeft).coloumn
Set PRange = DSheet.Range("A1").CurrentRegion

Set PCache = ActiveWorkbook.PivotCaches.Create_(SourceType:=xlDatabase, SourceData:=PRange)

Set PTable = PCache.CreatePivotTable(TableDestination:=PSheet.Cells(1, 1), TableName:="PRIMEPivotTable")

With PTable.PivotFields("Region")
    .Orientation = xlRowField
    .Position = 1
End With

Answer 1

これには片付けが必要ですが、開始する必要があります。

Option Explicitを使用しているため、変数を宣言する必要があることに注意してください。

列名は、提供されているワークブックのとおりです。

Option Explicit

Sub test()

     Dim PSheet As Worksheet
     Dim DSheet As Worksheet
     Dim LastRow As Long
     Dim LastCol As Long
     Dim PRange As Range
     Dim PCache As PivotCache
     Dim PTable As PivotTable

     Sheets.Add
     ActiveSheet.Name = "Pivottable"

    Set PSheet = Worksheets("Pivottable")
    Set DSheet = Worksheets("Sheet1")

    LastRow = DSheet.Cells(Rows.Count, 1).End(xlUp).Row
    LastCol = DSheet.Cells(1, Columns.Count).End(xlToLeft).Column
    Set PRange = DSheet.Range("A1").CurrentRegion

    Set PCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PRange)

    Set PTable = PCache.CreatePivotTable(TableDestination:=PSheet.Cells(1, 1), TableName:="PRIMEPivotTable")

    With PTable.PivotFields("Region")
        .Orientation = xlRowField
        .Position = 1
    End With

    With PTable.PivotFields("Channel")
        .Orientation = xlRowField
        .Position = 2
    End With

    With PTable.PivotFields("AW code")
        .Orientation = xlRowField
        .Position = 3
    End With

    PTable.AddDataField PSheet.PivotTables _
        ("PRIMEPivotTable").PivotFields("Bk"), "Sum of Bk", xlSum
    PTable.AddDataField PSheet.PivotTables _
        ("PRIMEPivotTable").PivotFields("DY"), "Sum of DY", xlSum
    PTable.AddDataField PSheet.PivotTables _
        ("PRIMEPivotTable").PivotFields("TOTal"), "Sum of TOTal", xlSum

End Sub

Answer 2

以下の私の回答のコードは少し長いですが、あなたが求めている結果を提供するはずです。

まず、安全のために、最初に"Pivottable"シートがRaw_dataワークブックオブジェクトにすでに存在するかどうかを確認します（再度作成する必要はありません）。

次に、コードは中央で2つのセクションに分かれています。

1. 以前にMACROが実行された場合（これは実行している2回以上）、"PRIMEPivotTable"ピボットテーブルはすでに作成されており、再度作成したり、ピボットテーブルを設定したりする必要はありません。田畑。 PivotTableを更新されたPivotCacheで更新するだけです（更新されたピボットキャッシュのソース範囲で）。
2. このMACROを初めて実行する場合は、PivotTableと必要なすべてのPivotFieldsをセットアップする必要があります。

各ステップの詳細説明は、コードのコメントに含まれています。

コード

Option Explicit

Sub AutoPivot()

Dim Raw_data As Workbook
Dim PSheet As Worksheet
Dim DSheet As Worksheet
Dim PTable As PivotTable
Dim PCache As PivotCache
Dim PRange As Range
Dim LastRow As Long, LastCol As Long
Dim Raw_Data_1 As String, Output As String, Start_Time As String

Start_Time = Time()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Raw_Data_1 = ThisWorkbook.Sheets(1).TextBox1.Text
Output = ThisWorkbook.Sheets(1).TextBox2.Text

' set the WorkBook object
Set Raw_data = Workbooks.Open(Raw_Data_1)

Set DSheet = Raw_data.Worksheets("Sheet1")

' first check if "Pivottable" sheet exits (from previous MACRO runs)
On Error Resume Next
Set PSheet = Raw_data.Sheets("Pivottable")
On Error GoTo 0

If PSheet Is Nothing Then '
    Set PSheet = Raw_data.Sheets.Add(before:=Raw_data.ActiveSheet) ' create a new worksheet and assign the worksheet object
    PSheet.Name = "Pivottable"
Else ' "Pivottable" already exists
    ' do nothing , or something else you might want

End If

With DSheet
    LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column

    ' set the Pivot-Cache Source Range with the values found for LastRow and LastCol
    Set PRange = .Range("A1", .Cells(LastRow, LastCol))
End With

' set a new/updated Pivot Cache object
Set PCache = ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=PRange.Address(True, True, xlA1, xlExternal))

' add this line in case the Pivot table doesn't exit >> first time running this Macro
On Error Resume Next
Set PTable = PSheet.PivotTables("PRIMEPivotTable") ' check if "PRIMEPivotTable" Pivot-Table already created (in past runs of this Macro)

On Error GoTo 0
If PTable Is Nothing Then ' Pivot-Table still doesn't exist, need to create it
    ' create a new Pivot-Table in "Pivottable" sheet
    Set PTable = PSheet.PivotTables.Add(PivotCache:=PCache, TableDestination:=PSheet.Range("A1"), TableName:="PRIMEPivotTable")

    With PTable
        ' add the row fields
        With .PivotFields("Region")
            .Orientation = xlRowField
            .Position = 1
        End With
        With .PivotFields("month")
            .Orientation = xlRowField
            .Position = 2
        End With
        With .PivotFields("number")
            .Orientation = xlRowField
            .Position = 3
        End With
        With .PivotFields("Status")
            .Orientation = xlRowField
            .Position = 4
        End With

        ' add the 3 value fields (as Sum of..)
        .AddDataField .PivotFields("value1"), "Sum of value1", xlSum
        .AddDataField .PivotFields("value2"), "Sum of value2", xlSum
        .AddDataField .PivotFields("TOTal"), "Sum of TOTal", xlSum
    End With

Else ' Pivot-Table "PRIMEPivotTable" already exists >> just update the Pivot-Table with updated Pivot-Cache (update Source Range)

     ' just refresh the Pivot cache with the updated Range
    PTable.ChangePivotCache PCache
    PTable.RefreshTable
End If

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub