VBA Excel 从同一数据库创建第二个数据透视表时出错

Question

我不是菜鸟，但还不是 VBA Excel 的专业人士，我遇到了一个我已经挣扎了一段时间的问题。

尝试在谷歌和这个论坛上阅读一些数据以获取指南或答案，但没有成功，所以我会向你解释，希望有人能给我一个提示或启发。

我想编写一个 VBA 宏，该宏从我的数据库创建一个名为"ClientProperties"的工作表，我将在其中创建一个数据透视表"PT2"，其中包含筛选的州/国家/地区上的所有客户端名称以及一些属性，例如应用于该客户端的促销名称，以及按月排序的促销值。然后它将创建一个新工作表，其中包含我的数据库上每个州/国家的名称，但在每个工作表中，我必须为每个客户端创建一个数据透视表("PT1"、"PT2"、..."PTn"(显示客户拥有的产品类别和按月排序的销售额;在该数据透视表下方，我必须粘贴该客户端的"PT2"中的属性。

我可以创建">

PT2"，应用过滤器并根据需要对信息进行排序，没有任何问题，但是当我尝试创建"PT1"时，它会显示错误：

"Error '5' has occurred at runtime:
Invalid argument or procedure call".

拳头枢轴实际上是这样创建的：

Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "ClientProperties"
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:="Base!R1C1:R50C100"_
Version:=6).CreatePivotTable TableDestination:="ClientProperties!R3C1", TableName:="DT1", DefaultVersion:=6

第二个(有错误的那个(像这样(注意：PL(X(是一个字符串数组[州/国家名称](：

For X = 0 To UBound(PL, 1)
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "" & PL(x) & ""
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:="Base!R1C1:R50C100"_
Version:=6).CreatePivotTable TableDestination:="" & PL(X) & "R8C23", TableName:="DT2", DefaultVersion:=6

这是我恢复的代码：

Global LBD As Long, ABD As Integer, LBB As Long, ABB As Integer, PL(11) As String, CA() As String, AN As String, CTE As Boolean, TR As String * 1, FBB As Integer
Global ASS() As String, CAP() As String, FTD As Integer, ITD As Boolean, LTD As Integer, PN As String * 1, CRK As Integer, CANCEL As Boolean
Sub Main()
Call Variables
Worksheets("Base").Visible = True
Worksheets("Base").Select
LBD = Rows(1, 1)
ABD = Columns(1, 1)
Call AditionalProcess
Call ClientProps
Call SummaryTabs
Worksheets("Base").Visible = False
Worksheets("ClientProperties").Visible = False
End Sub

其他模块是：

Sub Variables()
If TR = "M" Then
CTE = True
ReDim CA(3) As String
CA(0) = "Club"
CA(1) = "Conv"
CA(2) = "Reg"
CA(3) = "Ret"
Else
CTE = False
ReDim CA(3) As String
CA(0) = "Whs"
CA(1) = "C3"
CA(2) = "C5"
CA(3) = "Dist"
End If
PL(0) = "CALIFORNIA"
PL(1) = "FLORIDA"
If TR = "M" Then PL(2) = "AUSTIN" Else PL(2) = "HOUSTON"
PL(3) = "HAWAI"
PL(4) = "NEW JERSEY"
PL(5) = "ARIZONA"
PL(6) = "PENSILVANIA"
PL(7) = "VIRGINIA"
PL(8) = "MICHIGAN"
PL(9) = "GEORGIA"
PL(10) = "COLORADO"
PL(11) = "OHIO"
End Sub

Function Rows(X As Long, Y As Integer) As Long
Do While Cells(X, Y) <> Empty
X = X + 1
Loop
Rows = X - 1
End Function
Function Columns(X As Long, Y As Integer) As Long
Do While Cells(X, Y) <> Empty
Y = Y + 1
Loop
Columns = Y - 1
End Function

Sub AditionalProcess()
Worksheets("Base").Select
Range(Cells(2, 8), Cells(LBD, 8)).Copy
Sheets.Add After:=ActiveSheet
ActiveSheet.Paste
Application.CutCopyMode = False
Columns("A:A").RemoveDuplicates Columns:=1, Header:=xlNo
ReDim CAP(20) As String
For Y = 1 To 20
CAP(Y - 1) = Range(Cells(Y, 1), Cells(Y, 1))
Next Y
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True
End Sub

Sub ClientProps()
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "ClientProperties"
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:="Base!R1C1:R" & LBD & "C" & ABD & "", Version:=6).CreatePivotTable TableDestination:="ClientProperties!R3C1", TableName:="PT2", DefaultVersion:=6
Sheets("BB´s").Select
Cells(3, 1).Select
With ActiveSheet.PivotTables("PT2")
.ColumnGrand = True
.HasAutoFormat = True
.DisplayErrorString = False
.DisplayNullString = True
.EnableDrilldown = True
.ErrorString = ""
.MergeLabels = False
.NullString = ""
.PageFieldOrder = 2
.PageFieldWrapCount = 0
.PreserveFormatting = True
.RowGrand = True
.SaveData = True
.PrintTitles = False
.RepeatItemsOnEachPrintedPage = True
.TotalsAnnotation = False
.CompactRowIndent = 1
.InGridDropZones = False
.DisplayFieldCaptions = True
.DisplayMemberPropertyTooltips = False
.DisplayContextTooltips = True
.ShowDrillIndicators = True
.PrintDrillIndicators = False
.AllowMultipleFilters = False
.SortUsingCustomLists = True
.FieldListSortAscending = False
.ShowValuesRow = False
.CalculatedMembersInFilters = False
.RowAxisLayout xlCompactRow
.PageFieldOrder = xlDownThenOver
End With
With ActiveSheet.PivotTables("PT2").PivotCache
.RefreshOnFileOpen = False
.MissingItemsLimit = xlMissingItemsDefault
End With
ActiveSheet.PivotTables("PT2").RepeatAllLabels xlRepeatLabels
With ActiveSheet.PivotTables("PT2").PivotFields("FY")
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables("PT2").PivotFields("Client")
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables("PT2")
.ColumnGrand = False
.RowGrand = False
End With
ActiveSheet.PivotTables("PT2").AddDataField ActiveSheet.PivotTables("PT2").PivotFields("M01"), " M01", xlSum
ActiveSheet.PivotTables("PT2").AddDataField ActiveSheet.PivotTables("PT2").PivotFields("M02"), " M02", xlSum
ActiveSheet.PivotTables("PT2").AddDataField ActiveSheet.PivotTables("PT2").PivotFields("M03"), " M03", xlSum
ActiveSheet.PivotTables("PT2").AddDataField ActiveSheet.PivotTables("PT2").PivotFields("M04"), " M04", xlSum
ActiveSheet.PivotTables("PT2").AddDataField ActiveSheet.PivotTables("PT2").PivotFields("M05"), " M05", xlSum
ActiveSheet.PivotTables("PT2").AddDataField ActiveSheet.PivotTables("PT2").PivotFields("M06"), " M06", xlSum
ActiveSheet.PivotTables("PT2").AddDataField ActiveSheet.PivotTables("PT2").PivotFields("M07"), " M07", xlSum
ActiveSheet.PivotTables("PT2").AddDataField ActiveSheet.PivotTables("PT2").PivotFields("M08"), " M08", xlSum
ActiveSheet.PivotTables("PT2").AddDataField ActiveSheet.PivotTables("PT2").PivotFields("M09"), " M09", xlSum
ActiveSheet.PivotTables("PT2").AddDataField ActiveSheet.PivotTables("PT2").PivotFields("M10"), " M10", xlSum
ActiveSheet.PivotTables("PT2").AddDataField ActiveSheet.PivotTables("PT2").PivotFields("M11"), " M11", xlSum
ActiveSheet.PivotTables("PT2").AddDataField ActiveSheet.PivotTables("PT2").PivotFields("M12"), " M12", xlSum
With ActiveSheet.PivotTables("PT2").PivotFields("PROMOS")
.Orientation = xlRowField
.Position = 1
End With
LBB = Rows(8, 1)
ABB = Columns(7, 1)
Range(Cells(8, 2), Cells(LBB, ABB)).Style = "Comma"
Range(Cells(8, 2), Cells(LBB, ABB)).NumberFormat = "_-* #,##0_-;-* #,##0_-;_-* ""-""??_-;_-@_-"
ActiveSheet.PivotTables("PT2").PivotFields("PROMOS").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
ActiveWorkbook.ShowPivotTableFieldList = False
End Sub

Sub SummaryTabs()
For X = 0 To UBound(PL, 1)
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "" & PL(X) & ""        
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:="Base!R1C1:R" & LBD & "C" & ABD & "", Version:=6).CreatePivotTable TableDestination:="" & PL(X) & "!R8C23", TableName:="PT1." & (X+2), DefaultVersion:=6
End Sub

此时是出现错误消息的地方，这就是我剪切代码的原因......

Answer 1

两件事：

1. 您在循环范围之前缺少"！"(!R8C23而不是R8C23(
2. 数据透视表名称在循环中相同，这将不起作用

您也可以对所有透视使用相同的数据透视缓存，因为它始终相同，如下所示(此代码修复了这两个问题(：

Dim ws As Worksheet
Set ws = Sheets.Add(After:=ActiveSheet)
ws.Name = "ClientProperties"
Dim pc as PivotCache
Set pc = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:="Base!R1C1:R50C100", _ 
Version:=6)
pc.CreatePivotTable TableDestination:="ClientProperties!R3C1", TableName:="DT1", DefaultVersion:=6
For X = 0 To UBound(PL, 1)
Set ws = Sheets.Add(After:=ActiveSheet)
ws.Name = "" & PL(x) & ""
pc.CreatePivotTable TableDestination:="" & PL(X) & "!R8C23", TableName:="DT" & (X+2), DefaultVersion:=6

Answer 2

我刚刚找到了答案：

工作表名称位于：

TableDestination:="" & PL(X) & "!R8C23"

需要用单引号括起来才能工作：

TableDestination:="'" & PL(X) & "'!R8C23"

谢谢大家的支持!!