Question

我正在尝试在新工作表上创建数据透视表。另外，我想创建另一个调用，使用第一个数据表中的相同数据创建另一个不同的数据透视表。

下面的宏有问题。我认为这是一个小错误，但无法弄清楚。

Sub Macro2()

    Dim FinalRow            As Long
    Dim DataSheet           As String
    Dim PvtCache            As PivotCache
    Dim PvtTbl              As PivotTable
    Dim DataRng             As Range
    Dim TableDest           As Range
    Dim ws                  As Worksheet

    FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
    DataSheet = ActiveSheet.Name

    'set data range for Pivot Table -- ' conversion of R1C1:R & FinalRow & C15
     Set DataRng = Sheets(DataSheet).Range(Cells(1, 1), Cells(FinalRow, 15)) 

    Set ws = Worksheets.Add
    ws.Name = "Travel Payment Data by Employee"

    'set range for Pivot table placement -- Conversion of R1C1
    Set TableDest = Sheets("Travel Payment Data by Employee").Cells(1, 1)

    Set PvtCache = ActiveWorkbook.PivotCaches.Create(xlDatabase, DataRng, xlPivotTableVersion15)

    'check if "PivotTable4" Pivot Table already created (in past runs of this Macro)
    Set PvtTbl = ActiveWorkbook.Sheets("Travel Payment Data by Employee").PivotTables("PivotTable4")

    With PvtTbl.PivotFields("Security Org")
        .Orientation = xlRowField
        .Position = 1
    End With
    With PvtTbl.PivotFields("Fiscal Month")
        .Orientation = xlRowField
        .Position = 2
    End With
    With PvtTbl.PivotFields("Budget Org")
        .Orientation = xlRowField
        .Position = 3
    End With
    With PvtTbl.PivotFields("Vendor Name")
        .Orientation = xlRowField
        .Position = 4
    End With
    With PvtTbl.PivotFields("Fiscal Year")
        .Orientation = xlRowField
        .Position = 5
    End With
    With PvtTbl.PivotFields("Fiscal Year")
        .Orientation = xlColumnField
        .Position = 1
    End With
    PvtTbl.AddDataField ActiveSheet.PivotTables( _
        "PivotTable2").PivotFields("Dollar Amount"), "Sum of Dollar Amount", xlSum

End Sub

Answer 1

使用调用函数的子例程考虑以下调整，为新的相同数据透视表传入新工作表名称。如果您不打算使用相同的支点，请通过工作表名称或功能副本有条件地在代码中调整它们。您的代码的主要更改如下：

活动表：无需搜索ActiveSheet.Name，因为添加更多工作表会更改活动工作表。只需硬编码或传递数据源作为参数。
OBJECT CHECK：您需要检查Worksheet是否退出并且数据透视表是否存在。对于这些，您需要遍历所有当前此类对象并有条件地设置工作表，数据透视表对象（请参阅For...Next循环和If ... Is Nothing检查）。
对于PivotField，由于 Dollar Amounts 将存在于数据透视表数据源中但不一定显示，因此迭代所有这些可能不会像上面那样工作。因此，只有在没有错误的情况下才有条件地添加On Resume Next句柄。

<强> VBA

Option Explicit

Public Sub RunPivots()
    Call BuildPivot("Travel Payment Data by Employee")
    Call BuildPivot("Other Worksheet")
    Call BuildPivot("Still More Worksheet")
End Sub

Function BuildPivot(paramSheet As String)
On Error GoTo ErrHandle
    Dim FinalRow            As Long
    Dim DataSheet           As String
    Dim PvtCache            As PivotCache
    Dim PvtTbl              As PivotTable
    Dim PvtFld              As PivotField
    Dim DataRng             As Range
    Dim TableDest           As Range
    Dim ws                  As Worksheet

    FinalRow = Cells(Rows.Count, 1).End(xlUp).Row

    DataSheet = "DataSourceWorksheet"    
    ' set data range for Pivot Table
     Set DataRng = Sheets(DataSheet).Range(Cells(1, 1), Cells(FinalRow, 15))

    ' check if worksheet exists
    Dim currws As Worksheet
    For Each currws In ActiveWorkbook.Worksheets
        If currws.Name = paramSheet Then
            Set ws = Worksheets(paramSheet)
            Exit For
        End If
    Next currws

    ' create new worksheet if does not exist
    If ws Is Nothing Then
        Set ws = Worksheets.Add
        ws.Name = paramSheet
    End If

    ' set range for Pivot table placement
    Set TableDest = Sheets(paramSheet).Cells(1, 1)

    ' create pivot cache
    Set PvtCache = ActiveWorkbook.PivotCaches.Create( _
              SourceType:=xlDatabase, _
              SourceData:=DataRng, _
              Version:=xlPivotTableVersion15)

    'check if "PivotTable4" Pivot Table exists            
    Dim currpvt As PivotTable
    For Each currpvt In ws.PivotTables
        If currpvt.Name = "PivotTable4" Then
            Set PvtTbl = ws.PivotTables("PivotTable4")
            Exit For   
        End If
    Next currpvt

    ' create new pivot table if does not exist
    If PvtTbl Is Nothing Then
        Set PvtTbl = PvtCache.CreatePivotTable( _
            TableDestination:=TableDest, _
            TableName:="PivotTable4")
    End If

    With PvtTbl.PivotFields("Security Org")
        .Orientation = xlRowField
        .Position = 1
    End With
    With PvtTbl.PivotFields("Fiscal Month")
        .Orientation = xlRowField
        .Position = 2
    End With
    With PvtTbl.PivotFields("Budget Org")
        .Orientation = xlRowField
        .Position = 3
    End With
    With PvtTbl.PivotFields("Vendor Name")
        .Orientation = xlRowField
        .Position = 4
    End With
    With PvtTbl.PivotFields("Fiscal Year")
        .Orientation = xlRowField
        .Position = 5
    End With
    With PvtTbl.PivotFields("Fiscal Year")
        .Orientation = xlColumnField
        .Position = 1
    End With

    ' Add data field if does not exist
    On Error Resume Next
    PvtTbl.AddDataField PvtTbl.PivotFields("Dollar Amount"), "Sum of Dollar Amount", xlSum

    Exit Function

ErrHandle:
    MsgBox Err.Number & " - " & Err.Description, vbCritical, "RUNTIME ERROR"
    Exit Function
End Function

从单个数据源创建多个数据透视表

1 个答案: