Question

我现在已经尝试了几个小时来从VBA创建一个数据透视表。我尝试过各种代码，但我一直都会遇到错误。以下代码不会创建数据透视表，只会创建新工作表。我有一张名为＆＃34; Base＆＃34;我的所有数据都在哪里。它有18288行和13列数据。任何人都可以帮我解释为什么代码不适合我

Sub pivottable()

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
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("PivotTable").Delete
Sheets.Add Before:=ActiveSheet
ActiveSheet.Name = "PivotTable"
Application.DisplayAlerts = True
Set PSheet = Worksheets("PivotTable")
Set DSheet = Worksheets("Base")


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

Set PCache = ActiveWorkbook.PivotCaches.Create _
(SourceType:=xlDatabase, SourceData:=PRange). _
CreatePivotTable(TableDestination:=PSheet.Cells(2, 2), _
TableName:="PivotTable")

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


Sheets("PivotTable").Select


With ActiveSheet.PivotTables("PivotTable").PivotFields("FACULTY_ID")
    .Orientation = xlRowField
    .Position = 1
End With
With ActiveSheet.PivotTables("PivotTable").PivotFields("PROGRAM_TYPE_NAME")
    .Orientation = xlRowField
    .Position = 2
End With
ActiveSheet.PivotTables("PivotTable").AddDataField ActiveSheet.PivotTables( _
    "PivotTable").PivotFields("PROGRAM_TYPE_LETTER"), "Sum of amount", xlSum



End Sub

Answer 1

这可能对您有用：

Sub pivottable()

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
Dim new_sheet As Worksheet

On Error Resume Next
Application.DisplayAlerts = False
Worksheets("PivotTable").Delete
Application.DisplayAlerts = True
On Error GoTo 0

new_sheet_name = "PivotTable"
pivot_table_name = "pivot_name_here"

Set new_sheet = Sheets.Add(Before:=ActiveSheet)

With new_sheet
.Name = new_sheet_name
End With

Set PSheet = new_sheet
Set DSheet = Worksheets("Base")

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

Set PRange = DSheet.Cells(1, 1).Resize(LastRow, LastCol)

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

Set PTable = PCache.CreatePivotTable _
            (TableDestination:=PSheet.Cells(1, 1).Address(, , xlR1C1), TableName:=pivot_table_name)

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

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

With PTable
    .AddDataField ActiveSheet.PivotTables( _
    "PivotTable").PivotFields("PROGRAM_TYPE_LETTER"), "Sum of amount", xlSum
End With

End Sub

Answer 2

看起来这个链接很冷，但是如果有人要这样做，这是我根据其他答案（StackOverflow和其他地方）改编而成的代码，以创建多个数据透视表。此代码从上方接收一个包含7个销售员姓名的数组的全局变量。代码：

在每个“推销员”表上查找数据范围。
使用业务员的姓名创建数据透视表缓存（这是使其正常工作的关键）。
使用推销员的姓名创建数据透视表。
标记数据透视表并对其进行排序。
移至下一个表格。

  Sub Pivot_Maker() 'adapted from the internet. I added the arrays tho - AAI
  'as of 11/26/2019

  Dim FinalRow            As Long
  Dim DataSheet           As String
  Dim PvtCache            As PivotCache
  Dim PvtTbl(7)              As PivotTable
  Dim DataRng             As Range
  Dim TableDest           As Range


  i = 0


  Do While i < NumSalesPeeps
      Sheets(Salesman(i)).Select

  Range("A1").Select


If IsEmpty(Range("A30")) Then GoTo No_Data

    FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
    DataSheet = ActiveSheet.Name
    PvtTblName = ActiveSheet.Name & "pvt"

    ' set data range for Pivot Table
    Set DataRng = Sheets(DataSheet).Range(Cells(1, 1), Cells(FinalRow, 10))  ' conversion of R1C1:R & FinalRow & C8

    ' set range for Pivot table placement
    Set TableDest = Sheets(DataSheet).Cells(1, 12)  ' conversion of R1C9


    Set PvtCache = ActiveWorkbook.PivotCaches.Add(xlDatabase, DataRng)

    ' this line in case the Pivot table doesn't exit >> first time running this Macro
    On Error Resume Next
    Set PvtTbl(i) = ActiveWorkbook.Sheets(DataSheet).PivotTables(PvtTblName) ' check if PvtTblName Pivot Table already created (in past runs of this Macro)

    On Error GoTo 0
    If PvtTbl(i) Is Nothing Then ' PvtTblName doesn't exist >> create it

        ' create a new Pivot Table in PvtTblName sheet
    Set PvtTbl(i) = ActiveWorkbook.Sheets(DataSheet).PivotTables.Add(PivotCache:=PvtCache, TableDestination:=TableDest, TableName:=PvtTblName)


    With PvtTbl(i).PivotFields("Account")
            .Orientation = xlColumnField
            .Position = 1
        End With
        With PvtTbl(i).PivotFields("Name")
            .Orientation = xlRowField
            .Position = 1
        End With
        PvtTbl(i).AddDataField ActiveSheet.PivotTables( _
            PvtTblName).PivotFields("Amount"), "Sum of Amount", xlSum

    Else
        ' just refresh the Pivot cache with the updated Range
        PvtTbl(i).ChangePivotCache PvtCache
        PvtTbl(i).RefreshTable
    End If

    With ActiveSheet.PivotTables(PvtTblName).PivotFields("Sum of Amount")
        .NumberFormat = "$#,##0"
    End With
  No_Data:

  i = i + 1
 Loop
 End Sub

从VBA插入数据透视表

2 个答案: