将切片器连接到ll数据透视表

Question

现状： 我有一个excel 2010工作簿，其中包含一个名为Data的工作表。工作簿中的所有数据透视表都从该工作表中绘制。我有另一张名为Board的工作表，其中所有切片器都是，并且每个切片器都连接到工作簿中的所有数据透视表。

需要： 我必须经常对文件进行大修，在Data中添加一些列以及更多的pivot和切片器。当然，数据透视缓存不会自动更新。因此，新的枢轴不能与旧的切片机相关联。

战略： 1_我想得到一个宏来从所有数据透视表中分离所有切片器。这样，如果我添加一个新的数据透视表，我不需要再次通过每个切片器来链接它。 2_然后我想将所有数据透视缓存设置为我决定的范围（范围（“A1”）。数据上的CurrentRegion看起来很酷，否则我可以预留一个我手动更新的单元格）。 3_第三个也是最后一个，将每个切片器附加到工作簿中的每个数据透视表。

成就： 1_为1个切片器做了，猜测一个循环就可以了 2_有点做了，但是......嗯 3_没办法。我做不到这一点。

有什么建议？ 谢谢你的帮助，这真的是节省时间！

Answer 1

显然我做到了!! 我从网上拿了一些代码，我忘记了。希望这对某人有用!!!

Sub ManageSlicers(Connect_Disconnect As String)
'feed in *connect* or *disconnect* accordingly to get it applied to all slicers in *Board*.
Dim oSlicer As Slicer
Dim oSlicercache As SlicerCache
'
Dim wks As Worksheet
Dim pt As PivotTable

For Each oSlicercache In ActiveWorkbook.SlicerCaches
    For Each oSlicer In oSlicercache.Slicers
        If oSlicer.Shape.BottomRightCell.Worksheet.Name = "Board" Then
            For Each wks In Worksheets
                For Each pt In wks.PivotTables
                    If Connect_Disconnect = "connect" Then
                        oSlicer.SlicerCache.PivotTables.AddPivotTable (Sheets(wks.Name).PivotTables(pt.Name))
                    ElseIf Connect_Disconnect = "disconnect" Then
                        oSlicer.SlicerCache.PivotTables.RemovePivotTable (Sheets(wks.Name).PivotTables(pt.Name))
                    Else
                        MsgBox "Macro ManageSlicers messed up."
                    End If
                Next
            Next
        End If
    Next
Next

Set oSlicer = Nothing
Set oSlicercache = Nothing
Set pt = Nothing
Set wks = Nothing
End Sub

Sub UpdatePivotCache()
'update pivottables cache
Dim wks As Worksheet
Dim pt As PivotTable

For Each wks In ActiveWorkbook.Worksheets
    For Each pt In wks.PivotTables
        If lIndex = 0 Then
            pt.ChangePivotCache _
                ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
                                                SourceData:=Sheets("Data").Range("A1").CurrentRegion.Address(ReferenceStyle:=xlR1C1))
            Set ptMain = pt
            lIndex = 1
        Else
            pt.CacheIndex = ptMain.CacheIndex
        End If
    Next pt
Next wks
End Sub

Sub RefreshSlicersAndPivots()
ThisWorkbook.RefreshAll
Call ManageSlicers("disconnect")
Call UpdatePivotCache
Call ManageSlicers("connect")
End Sub