excel - VBA Excel 错误从同一数据库创建第二个数据透视表

问题描述

我不是一个菜鸟，但还不是 VBA Excel 的专业人士，我遇到了一个我一直在苦苦挣扎的问题。

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

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

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

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

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

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

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

标签： excelvba

excel - VBA Excel 错误从同一数据库创建第二个数据透视表

问题描述

解决方案

推荐阅读