Question

由于EPPlus不支持对数据透视表源范围的操作（更具体地说，可以更新缓存定义，但保存文件后不保留此更新），我不得不求助于模板本身的VBA更新源范围并刷新数据透视表。

对于存储在文件中的2个数据源和2个关联的PivotCache对象，每个都有几个数据透视表。我的目标是将所有数据透视表更新为2个来源中的新单元格范围。由于我不想复制一堆数据透视表来执行此操作，因此我只创建第一个，然后尝试将共享相关数据集的后续数据透视表更新到同一个缓存。

以下是从其中一个缓存（“下载”）更新枢轴的摘录。该函数的其余部分对第二个缓存执行完全相同的操作（它嵌套在相同的循环中，但为了简洁而省略）。

Set downloads = ThisWorkbook.Worksheets("DLRaw")
For Each ws In ActiveWorkbook.Worksheets
    For Each pt In ws.PivotTables
        If Not downloadsCreated Then                
            Set startCell = downloads.Range("A8")
            Set endCell = downloads.Range("Y" & startCell.SpecialCells(xlLastCell).Row)
            Set dataRange = downloads.Range(startCell, endCell)
            newRange = downloads.Name & "!" & dataRange.Address(ReferenceStyle:=xlR1C1)

            pt.ChangePivotCache _
            ThisWorkbook.PivotCaches.Create(xlDatabase, newRange)
            Set downloadsCache = pt.PivotCache
            downloadsCreated = True                    
        Else                    
            If pt.CacheIndex <> downloadsCache.Index Then pt.CacheIndex = downloadsCache.Index                    
        End If

        pt.RefreshTable

        For Each rf In pt.RowFields
            If rf.Position <> pt.RowFields.count Then
                rf.ShowDetail = False
            End If
        Next rf
        For Each cf In pt.ColumnFields
            If cf.Position <> pt.ColumnFields.count Then
                cf.ShowDetail = False
            End If
        Next cf
    Next pt
Next ws

我一直得到关于null实体的运行时错误'1004'，被Else块中的行抛出。单步执行代码，我注意到新创建的数据透视缓存的CacheIndex为0，因此未分配downloadsCache对象，或者新缓存不是正在创建。我确实在范围变量中看到了正确的值。此行为既存在于上面的下载摘录中，也存在于第二个缓存的数据透视表中。

关于在哪里寻找下一步的想法，或者在必要时解决这个问题的不同方法？

Answer 1

尝试使用以下代码更新工作表中PivotTable的所有PivotCache。

<强>代码

Option Explicit

Sub UpdatePivotTables()

Dim ws                  As Worksheet
Dim downloads           As Worksheet
Dim PT                  As PivotTable
Dim PTCache             As PivotCache

Dim startCell As Range, endCell As Range
Dim dataRange As Range
Dim newRange As String

Set downloads = ThisWorkbook.Worksheets("DLRaw")
For Each ws In ActiveWorkbook.Worksheets
    ' the Range setting needs to be done once >> take outside the loop
    Set startCell = downloads.Range("A8")
    Set endCell = downloads.Range("Y" & startCell.SpecialCells(xlLastCell).Row)
    Set dataRange = downloads.Range(startCell, endCell)
    newRange = dataRange.Address(False, False, xlR1C1, xlExternal) '<-- get the range address including the sheet's name (and workbook if needed)

    For Each PT In ws.PivotTables
        ' set the pivot cache
        Set PTCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=newRange)

        ' update the Pivot Table with the updated Pivot Cache's Source Data
        PT.ChangePivotCache PTCache
        PT.RefreshTable

        Set PTCache = Nothing ' reset for next cycle
    Next PT
Next ws

End Sub

Answer 2

Private Sub GenerateReport_Click()

Dim PTable As PivotTable
Dim PCache As PivotCache
Dim PRange As Range
Dim PSheet As Worksheet
Dim DSheet As Worksheet
Dim LastRow As Long
Dim LastCol As Long

    On Error Resume Next
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Worksheets("Report").Delete
    Sheets.Add(After:=Sheets("CheckList")).Name = "Report"
    ActiveSheet.Name = "Report"
    Application.DisplayAlerts = True
    Set PSheet = Worksheets("Report")
    Set DSheet = Worksheets("Checklist")


    LastRow = DSheet.Cells(Rows.Count, 1).End(xlUp).Row
    LastCol = DSheet.Cells(1, Columns.Count).End(xlToLeft).Column
    Set PRange = DSheet.Cells(1, 1).Resize(LastRow, LastCol)



    Set PCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PRange.CurrentRegion)


    Set PTable = PCache.CreatePivotTable(TableDestination:=PSheet.Cells(2, 2), TableName:="AuditReport")
    
End Sub

Excel数据透视表更新 - 不创建数据透视表（VBA）

2 个答案: