我正在编写一个代码,该代码将基于动态范围创建数据透视表。但是,我在创建数据透视缓存时遇到了问题。当我运行代码时,没有错误消息出现,但是创建了没有工作表的空白工作表。我认为问题是数据透视缓存,但可能是错误的。有什么想法吗?
我已经多次浏览代码,但是找不到错误。一切似乎都按预期进行,除了没有数据透视表。
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
我希望在新工作表上包含我的范围的数据透视表,但什么也没得到。
答案 0 :(得分:2)
请尝试以下修改后的代码:
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