Excel 如何在VBA中创建透视表？

我试图使用下面的代码在Excel2010中创建一个透视表，但似乎无法使其正常工作

它甚至创建了一个名为“数据透视表”的新选项卡，但实际上没有数据出现。我尝试使用的功能是将excel中生成的报表中的数据复制到pivot generator上的选项卡中，然后按下按钮，它将创建pivot表。这是我在Excel Champs上找到的一个代码，但是这个线程似乎已经死了，没有问题的答案

Sub InsertPivotTable()
'Macro By ExcelChamps

'Declare Variables
 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

`'Insert a New Blank Worksheet
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("Data")

'Define Data Range
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)

'Define Pivot Cache
Set PTable = ActiveWorkbook.PivotCaches.Create _
(SourceType:=xlDatabase, SourceData:=PRange). _
CreatePivotTable(TableDestination:=PSheet.Cells(2, 2), _
TableName:="DefectsPivotTable")

'Insert Blank Pivot Table
Set PTable = PCache.CreatePivotTable _
(TableDestination:=PSheet.Cells(1, 1), TableName:="DefectsPivotTable")

'Insert Row Fields
With ActiveSheet.PivotTables("DefectsPivotTable").PivotFields("Assigned to").Orientation = xlRowField.Position = 1
End With

'Insert Column Fields
With ActiveSheet.PivotTables("DefectsPivotTable").PivotFields("Status").Orientation = xlColumnField.Position = 1
End With



'Insert Data Field
With ActiveSheet.PivotTables("DefectsPivotTable").PivotFields("Status").Orientation = xlDataField.Function = xlSum.NumberFormat = "#,##0".Name = "Revenue "
End With

'Format Pivot Table
ActiveSheet.PivotTables("SalesPivotTable").ShowTableStyleRowStripes = True
ActiveSheet.PivotTables("SalesPivotTable").TableStyle2 = "PivotStyleMedium9"

End Sub

---

看起来你很接近！试试这样的

Sub CreatePivotTable()
Dim sht As Worksheet
Dim pvtCache As PivotCache
Dim pvt As PivotTable
Dim StartPvt As String
Dim SrcData As String

'Determine the data range you want to pivot
  SrcData = ActiveSheet.Name & "!" & Range("A1:R100").Address(ReferenceStyle:=xlR1C1)

'Create a new worksheet
  Set sht = Sheets.Add

'Where do you want Pivot Table to start?
  StartPvt = sht.Name & "!" & sht.Range("A3").Address(ReferenceStyle:=xlR1C1)

'Create Pivot Cache from Source Data
  Set pvtCache = ActiveWorkbook.PivotCaches.Create( _
    SourceType:=xlDatabase, _
    SourceData:=SrcData)

'Create Pivot table from Pivot Cache
  Set pvt = pvtCache.CreatePivotTable( _
    TableDestination:=StartPvt, _
    TableName:="PivotTable1")

End Sub

---

只需将您的

LastRow

和

LastCol

作为动态范围传递，就像您现在所做的那样

首先，在下一步恢复时注释掉/删除

。这样，您将看到代码中有什么（如果有的话）不起作用。就目前情况而言，这只会贯穿整个过程，但不会告诉您失败的地方和原因。然后，提供一个描述如何使用此宏的示例数据。插入行/列/数据字段的语法看起来不正确。您还可以使用
PTable
两次，而不是
PTable
和
PCache
。