如何定义数据透视缓存？

Question

我正在编写一个基于动态范围创建数据透视表的代码。但是，我在创建数据透视缓存时遇到问题。当我运行代码时，没有出现错误消息，但是会创建一个没有数据透视表的空白工作表。我认为问题在于数据透视缓存，但可能是错误的。有什么想法吗？

我已多次单步执行代码，但找不到错误。一切似乎都在正常工作，除了没有出现数据透视表。

Option Explicit

Dim pivotSht As Worksheet
Dim dataSht As Worksheet
Dim pCache As PivotCache
Dim pTable As PivotTable
Dim pRange As Range
Dim lastR As Long
Dim lastC As Long

Public Sub buildPivot()

'CREATES PIVOT TABLE FROM OPEN ORDER BOOK DATA

'Deletes old sheet, if available, and creates a new one
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("PivotTable").Delete
Sheets.Add before:=ActiveSheet
ActiveSheet.Name = "PivotTable"
Application.DisplayAlerts = True

Set pivotSht = Worksheets("PivotTable")
Set dataSht = Worksheets("OOB")

'Defines data range in "OOB" sheet
lastR = dataSht.Cells(Rows.Count, "D").End(xlUp).Row
lastC = dataSht.Cells(4, Columns.Count).End(xlToLeft).Column
Set pRange = dataSht.Range("D1").Resize(lastR, lastC)

'Define pivot cache
Set pCache = ActiveWorkbook.PivotCaches.Create _
(SourceType:=xlDatabase, SourceData:=pRange). _
CreatePivotTable(tabledestination:=pivotSht.Cells(3, 1), _
TableName:="OpenOrderBookTable")

'Insert blank pivot table
Set pTable = pCache.CreatePivotTable _
(tabledestination:=pivotSht.Cells(3, 1), TableName:="OpenOrderBookTable")

'Insert row fields in pivot table
With ActiveSheet.PivotTables("OpenOrderBookTable").PivotFields("Machine")
    .Orientation = xlRowField
    .Position = 1
End With

'Insert column fields in pivot table
With ActiveSheet.PivotTables("OpenOrderBookTable").PivotFields("OTD")
    .Orientation = xlColumnField
    .Position = 1
End With

'Insert data fields
ActiveSheet.PivotTables("OpenOrderBookTable").AddDataField ActiveSheet.PivotTables( _
    "OpenOrderBookTable").PivotFields("OTD"), "Count of OTD", xlCount

With ActiveSheet.PivotTables("OpenOrderBookTable").PivotFields("System Status")
    .Orientation = xlPageField
    .Position = 1
End With

我希望在新工作表上有一个包含我的范围的数据透视表，但我什么也没得到。

Answer 1

试试下面的修改代码：

Public Sub buildPivot()

'CREATES PIVOT TABLE FROM OPEN ORDER BOOK DATA

'Deletes old sheet, if available, and creates new one
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("PivotTable").Delete
Sheets.Add before:=ActiveSheet
ActiveSheet.Name = "PivotTable"
Application.DisplayAlerts = True

Set pivotSht = Worksheets("PivotTable")
Set dataSht = Worksheets("OOB")

'Defines data range in "OOB" sheet
With dataSht
    lastR = .Cells(.Rows.Count, "D").End(xlUp).Row
    lastC = .Cells(4, .Columns.Count).End(xlToLeft).Column
    Set pRange = .Range(.Cells(1, "D"), .Cells(lastR, lastC))
End With

'Define pivot cache
Set pCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=pRange.Address(False, False, xlA1, xlExternal))

'Insert blank pivot table
Set pTable = pivotSht.PivotTables.Add(PivotCache:=pCache, TableDestination:=pivotSht.Range("A3"), TableName:="OpenOrderBookTable")

'Insert row fields in pivot table
With pTable.PivotFields("Machine")
    .Orientation = xlRowField
    .Position = 1
End With

'Insert column fields in pivot table
With pTable.PivotFields("OTD")
    .Orientation = xlColumnField
    .Position = 1
End With

'Insert data fields
pTable.AddDataField pTable.PivotFields("OTD"), "Count of OTD", xlCount

With pTable.PivotFields("System Status")
    .Orientation = xlPageField
    .Position = 1
End With

End Sub