Excel 数据透视表更新 - 不创建数据透视缓存 (VBA)

Question

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

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

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

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

我一直收到关于空实体的运行时错误“1004”，由Else 块中的行抛出。单步执行代码，我注意到新创建的数据透视缓存的CacheIndex 是0，所以要么没有分配downloadsCache 对象，要么一开始就没有创建新的缓存.我确实在范围变量中看到了正确的值。上述下载摘录和第二个缓存的数据透视表都存在这种行为。

对于下一步该往哪里看有什么想法，或者如果有必要可以用不同的方法来解决这个问题？

Answer 1

试试下面的代码，用一个PivotCache更新工作表中的所有PivotTables。

代码

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