Excel VBA 创建新的 PivotCache 并连接多个数据透视表

Question

我有一个包含许多数据透视表的工作簿，这些数据透视表基于使用 VBA 删除和刷新的范围。 目前，为了更新数据源，作为该子例程的最后一部分，我为每个数据透视表重新创建数据透视缓存并刷新。

我只希望将 6 个表与一个公共 PivotCache 链接在一起，以便它们可以共享切片器等，但我无法使其正常工作。

我已经四处寻找解决方案，但我一直在做空，而且我已经坚持了一段时间。 我对 VBA 相当陌生，但我通常可以通过反复试验来解决它，但这让我很难过。

我显然做错了什么，任何帮助确定是什么，将不胜感激。

谢谢 ：）

我当前的代码如下（注意：为了便于阅读，我从代码中删除了不相关的内容）：

Sub RunReport()


On Error GoTo ErrorHandler

'##############         Define Variables        ##############


    Dim WS_O As Worksheet           'Output sheet - report sheet
    Dim WS_P As Worksheet           'Pivot table Sheet
    Dim OuputRow As Integer         'First row for output of data
    Dim LastRow_O As Integer        'Last used row of output sheet
    Dim PivotCacheName As PivotCache
    Dim PivotRange As String        'Range of data for Pivot Data Source
    Dim PivotName1 As String        'Pivot Table Name Strings
    Dim PivotName2 As String
    Dim PivotName3 As String
    Dim PivotName4 As String
    Dim PivotName5 As String
    Dim PivotName6 As String
    


'##############   Modify Application Settings   ##############

'Store current configuration

    OriginalCalcMode = Application.Calculation
    
'Set configuration for fastest processing

    Application.Calculation = xlManual
    Application.ScreenUpdating = False
    Application.EnableEvents = False


'##############       Set Variable Values       ##############


'Worksheets

    Set WS_O = Sheets("Report")                             'Output sheet - report sheet
    Set WS_P = Sheets("Pivot Tables - Live Data")           'Pivot tables sheet
    
    
'Pivot Tables

    PivotName1 = "PivotTable1"
    PivotName2 = "PivotTable2"
    PivotName3 = "PivotTable3"
    PivotName4 = "PivotTable4"
    PivotName5 = "PivotTable5"
    PivotName6 = "PivotTable6"
    
    
'General

    OutputRow = 7
    
    
'Used Ranges

    LastRow_O = WS_O.Range("A" & Rows.Count).End(xlUp).Row

 
    
 '##############     Refresh Pivot Tables        ##############


'Define Data Range

    PivotRange = WS_O.Name & "!" & "A" & OutputRow - 1 & ":AM" & LastRow_O


'Error Handling
  
    'Make sure every column in data set has a heading and is not blank
    If WorksheetFunction.CountBlank(WS_O.Range("A" & OutputRow - 1 & ":AM" & LastRow_O).Rows(1)) > 0 Then
        MsgBox "One or more columns in ''Report'' sheet has a blank heading;" & vbNewLine _
        & "This has prevented the pivot tables from refreshing correctly." & vbNewLine & vbNewLine _
        & "Please verify cells A" & OutputRow - 1 & ":AM" & OutputRow - 1 & " in ''Report'' sheet are not blank and try again.", vbCritical, "ERROR - Column Heading Missing"
        GoTo EndSub
    End If


'Change Pivot Data Sources to a single cache

    Set PivotCacheName = ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PivotRange, Version:=xlPivotTableVersion15)

    WS_P.PivotTables(PivotName1).ChangePivotCache (PivotCacheName)
    WS_P.PivotTables(PivotName2).ChangePivotCache (PivotCacheName)
    WS_P.PivotTables(PivotName3).ChangePivotCache (PivotCacheName)
    WS_P.PivotTables(PivotName4).ChangePivotCache (PivotCacheName)
    WS_P.PivotTables(PivotName5).ChangePivotCache (PivotCacheName)
    WS_P.PivotTables(PivotName6).ChangePivotCache (PivotCacheName)


'Refresh Pivot Tables

    'Turn on auto calc while pivot's update
    Application.Calculation = xlCalculationAutomatic


    WS_P.PivotTables(PivotName1).RefreshTable
    WS_P.PivotTables(PivotName2).RefreshTable
    WS_P.PivotTables(PivotName3).RefreshTable
    WS_P.PivotTables(PivotName4).RefreshTable
    WS_P.PivotTables(PivotName5).RefreshTable
    WS_P.PivotTables(PivotName6).RefreshTable


   
'Completion Confirmation
  
        MsgBox "Report data has been compiled and pivot tables have been successfully refreshed.", vbInformation, "SUCCESS! - Report Compilation Complete"

    
'##############   End Sub and Reset Application Configuration   ##############


'Standard End Sub Functionality (where no undocumented error occurred)

EndSub:
        Application.ScreenUpdating = False
        Application.Calculation = OriginalCalcMode   'Reset calc option to what it was previously
        Application.EnableEvents = True
    Exit Sub


'Error Handling (where an undocumented error occurred - that is, an error without an explainatory message box)

ErrorHandler:
    Application.ScreenUpdating = False
'    Application.Calculation = OriginalCalcMode
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    
     MsgBox "An error caused this subroutine to stop working correctly." & vbNewLine _
        & "Contact Administrator for assistance.", vbCritical, "ERROR - Contact Administrator"
       
    
End Sub

我以前使用过这个，但仍然适用于我不想使用相同 PivotCache 的某些表：

'Create new caches for each table

    WS_P.PivotTables(PivotName1).ChangePivotCache _
        ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PivotRange)
        
    WS_P.PivotTables(PivotName2).ChangePivotCache _
        ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PivotRange)
        
    WS_P.PivotTables(PivotName3).ChangePivotCache _
        ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PivotRange)
        
    WS_P.PivotTables(PivotName4).ChangePivotCache _
        ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PivotRange)
        
    WS_P.PivotTables(PivotName5).ChangePivotCache _
        ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PivotRange)
         
    WS_P.PivotTables(PivotName6).ChangePivotCache _
        ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PivotRange)
        

我目前在此处收到运行时 438 错误（对象不支持此属性或方法）>>>

    WS_P.PivotTables(PivotName1).ChangePivotCache (PivotCacheName)

编辑：我找到了一个解决方案并在下面添加了一个答案。

Answer 1

所以，经过一夜好眠和几个小时的研究，我有了我认为的解决方案。

这可能不是最好的方法，但它有效并且还没有给我带来任何问题......

'Create New Pivot Cache from Data Range
    WS_P.PivotTables(PivotName1).ChangePivotCache _
        ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PivotRange)
  
'Link Other Pivot Tables to same Pivot Cache     
  
    WS_P.PivotTables(PivotName2).CacheIndex = WS_P.PivotTables(PivotName1).CacheIndex
    WS_P.PivotTables(PivotName3).CacheIndex = WS_P.PivotTables(PivotName1).CacheIndex
    WS_P.PivotTables(PivotName4).CacheIndex = WS_P.PivotTables(PivotName1).CacheIndex
    WS_P.PivotTables(PivotName5).CacheIndex = WS_P.PivotTables(PivotName1).CacheIndex
    WS_P.PivotTables(PivotName6).CacheIndex = WS_P.PivotTables(PivotName1).CacheIndex

我仍然不确定为什么另一种方式不起作用所以仍然会感谢一些反馈，如果有人有任何反馈，因为这种方法确实禁止我将切片器附加到所有数据透视表（我必须将第一个放在外面）。