VBA断开切片器与透视表关联改数据源后重连的代码报错修复

问题修复说明 #

• 原代码报错核心原因为SlicerCache对象不存在Caption属性，需替换为Name属性获取切片器缓存的唯一标识
• 原代码冗余拼接了Slicer_前缀二次检索切片器缓存，遍历得到的vItem本身就是SlicerCache实例，可直接操作
• 补充了变量初始化优化，避免未定义值导致的异常

Sub Change_Pivot_Source()
    Dim PT As PivotTable
    Dim ptMain As PivotTable
    Dim ws As Worksheet
    Dim oDic As Object
    Dim oPivots As Object
    Dim i As Long
    Dim lIndex As Long
    Dim vPivots As Variant
    Dim vItem As SlicerCache
    
    ' 初始化变量
    lIndex = 0
    Set oDic = CreateObject("Scripting.Dictionary")

    ' 存储切片器关联关系并断开连接
    For Each vItem In ThisWorkbook.SlicerCaches
        With vItem.PivotTables
            If .Count > 0 Then
                Set oPivots = CreateObject("Scripting.Dictionary")
                ' 倒序遍历避免删除后索引错位
                For i = .Count To 1 Step -1
                    oPivots.Add .Item(i).Name, .Item(i)
                    .RemovePivotTable .Item(i)
                Next i
                oDic.Add vItem.Name, oPivots
            End If
        End With
    Next vItem

    ' 统一更新所有数据透视表数据源
    For Each ws In ThisWorkbook.Worksheets
        For Each PT In ws.PivotTables
            If lIndex = 0 Then
                ' 第一个透视表创建新缓存，此处数据源可根据需求修改
                PT.ChangePivotCache _
                    ActiveWorkbook.PivotCaches.Create( _
                        SourceType:=xlDatabase, _
                        SourceData:="Info[[Promo number]:[cost actual_new]]")
                Set ptMain = PT
                lIndex = 1
            Else
                ' 其余透视表复用第一个的缓存，减少文件体积
                PT.CacheIndex = ptMain.CacheIndex
            End If
        Next PT
    Next ws

    ' 恢复切片器关联关系
    For Each vItem In ThisWorkbook.SlicerCaches
        If oDic.Exists(vItem.Name) Then
            Set oPivots = oDic(vItem.Name)
            vPivots = oPivots.Items
            For i = LBound(vPivots) To UBound(vPivots)
                vItem.PivotTables.AddPivotTable vPivots(i)
            Next i
        End If
    Next vItem

    ' 释放对象
    Set oDic = Nothing
    Set oPivots = Nothing
    Set ptMain = Nothing
    Set ws = Nothing
    Set PT = Nothing

    MsgBox "数据源更新完成，切片器关联已恢复", vbInformation
End Sub

使用注意事项 #

• 代码中SourceData参数为你原配置的结构化引用，若后续数据源的表名、列范围有调整，需修改为对应正确的数据源范围
• 运行代码前请先备份原Excel文件，避免异常操作导致数据丢失
• 所有数据透视表会共享同一个缓存，可有效降低文件大小、提升刷新速度

内容的提问来源于stack exchange，提问作者Nikita