Question

我是vba的新手，正在尝试使用带有Excel的VBA创建PivotTable。

我想创建如下图所示的输入表。

我正在尝试添加region，month，number，status的行标签，值为value1，value2和{ {1}}这里我可以为pivot设置范围，而执行它会创建＆＃34; pivottable＆＃34;仅限表格。不为sheet1生成任何数据透视表。

我的代码：

total

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部分：

如果之前运行了MACRO（这是你运行它的2倍以上），那么"PRIMEPivotTable"已经创建了Pivot-Table，并且无需再次创建它，也无需设置Pivot-Table的字段。您需要做的就是使用更新的PivotTable刷新PivotCache（使用更新的Pivot-Cache的源范围）。
如果这是第一次运行此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

如何使用vba创建数据透视表

2 个答案: