Excel VBA创建Pivot，没有表出现

Question

我在下面的VBA代码尝试根据“Sheet2”中的数据创建数据透视表，添加新工作表“数据透视表”并在此工作表上创建数据透视表。

但是代码执行没有错误，新工作表“数据透视表”上没有表格，我看不出原因。

此外，PT的Sheet2上的数据当前从B列开始，不确定这是否有效。

Dim PSheet As Worksheet
Dim DSheet As Worksheet
Dim PCache As PivotCache
Dim PTable As PivotTable
Dim PRange As Range
Dim LastRow1 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("Sheet2")



'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 PCache = ActiveWorkbook.PivotCaches.Create _
(SourceType:=xlDatabase, SourceData:=PRange). _
CreatePivotTable(TableDestination:=PSheet.Cells(2, 2), _
TableName:="MilestonePivotTable")



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



'Insert Row Fields
With ActiveSheet.PivotTables("MilestonePivotTable").PivotFields("Resource Name")
.Orientation = xlRowField
.Position = 1
End With

With ActiveSheet.PivotTables("MilestonePivotTable").PivotFields("Deliverable")
.Orientation = xlRowField
.Position = 2
End With

'Insert Column Fields
With ActiveSheet.PivotTables("MilestonePivotTable").PivotFields("Milestone Date")
.Orientation = xlColumnField
.Position = 1
End With

Answer 1

只有半测试（由于只有虚拟数据），但我相信以下内容将解决您的所有错误：

Dim PSheet As Worksheet
Dim DSheet As Worksheet
Dim PCache As PivotCache
Dim PTable As PivotTable
Dim PRange As Range
'LastRow was not declared
Dim LastRow As Long
'LastRow1 is not used
'Dim LastRow1 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
'Switch off error "masking" once you don't need it
On Error GoTo 0
Set PSheet = Worksheets("PivotTable")
Set DSheet = Worksheets("Sheet2")



'Define Data Range
'a) Base last row on column B if you don't have data in column A
'b) Use "DSheet.Rows.Count" and "DSheet.Columns.Count" - although not strictly
'   necessary in this situation, it is a good practice to get into
LastRow = DSheet.Cells(DSheet.Rows.Count, "B").End(xlUp).Row
LastCol = DSheet.Cells(1, Dsheet.Columns.Count).End(xlToLeft).Column
'Don't include column A in your data range
Set PRange = DSheet.Cells(1, "B").Resize(LastRow, LastCol - 1)


'Define Pivot Cache (not pivot table)
Set PCache = ActiveWorkbook.PivotCaches.Create _
    (SourceType:=xlDatabase, SourceData:=PRange)
'Set PCache = ActiveWorkbook.PivotCaches.Create _
'(SourceType:=xlDatabase, SourceData:=PRange). _
'CreatePivotTable(TableDestination:=PSheet.Cells(2, 2), _
'TableName:="MilestonePivotTable")



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


'Use PSheet instead of ActiveSheet in all the following statements
'In fact, because the PTable object exists, we can just use it

'Insert Row Fields
'With AciveSheet.PivotTables("MilestonePivotTable").PivotFields("Resource Name")
'With PSheet.PivotTables("MilestonePivotTable").PivotFields("Resource Name")
With PTable.PivotFields("Resource Name")
    .Orientation = xlRowField
    .Position = 1
End With

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

'Insert Column Fields
With PTable.PivotFields("Milestone Date")
    .Orientation = xlColumnField
    .Position = 1
End With

Answer 2

我使用相同的代码创建数据透视表。但是在以下代码段中出现错误“ Type Mismatch”。我试图解决这个问题。是PRange不匹配吗？

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