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

时间:2014-02-26 16:26:57

标签: excel-vba excel-2010 pivot-table vba excel

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

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

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

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

有什么建议吗? 谢谢你的帮助,这真的是节省时间!

1 个答案:

答案 0 :(得分:2)

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

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