使用VBA将切片器连接到所有数据透视表？

Question

我正在编写 VBA 代码来生成一系列 12 个数据透视表，这些数据透视表都连接到相同的切片器。

为了将切片器连接到数据透视表，我实现了一种循环方法，其中通过代码生成第一个数据透视表，然后所有切片器都连接到该数据透视表。然后将第一个数据透视表复制并粘贴到右侧偏移 2 列、清除、重命名，然后填充相关的数据透视表字段。然后对剩余的数据透视表重复此操作。

这是代码示例：

Sub Pivot_Generation()

Application.ScreenUpdating = False
    
    Sheets("Pivots").Activate

Dim TblNam As String
Dim TblRk As Integer

TblRank = 1

' Creation of the first pivot table

    ThisWorkbook.PivotCaches.Create(SourceType:=xlExternal, SourceData:= _
        ThisWorkbook.Connections("ThisWorkbookDataModel"), Version:=6). _
        CreatePivotTable TableDestination:="Pivots!R3C3", tableName:= _
        "NewPivot", DefaultVersion:=6

    For i = 1 To 3
        If TblRank = 1 Then
            TblNam = "Pivot1” 
        ElseIf TblRank = 2 Then
            TblNam = " Pivot2 "
        ElseIf TblRank = 3 Then
            TblNam = " Pivot3 "
        End If

    If TblRank = 1 Then
        ActiveSheet.pivotTables(1).name = TblNam
        Pivot1_Fields
        Slicers
    Else:
        ActiveSheet.pivotTables(1).TableRange1.Select
        Selection.Copy
        Selection.Cells(1, 1).Select
        Selection.End(xlToRight).End(xlToRight).End(xlToLeft).Offset(0, 2).Select
        ActiveSheet.Paste
        ActiveSheet.pivotTables(1).ClearTable
        ActiveSheet.pivotTables(1).name = TblNam

            If TblRank = 2 Then
                Pivot2_Fields
            ElseIf TblRank = 3 Then
                Pivot3_Fields
            End If
        End If
        TblRank = TblRank + 1

    Next i
End Sub

模块“Slicers”用于生成切片器并将其连接到第一个数据透视表，如下所示：

Sub Slicers()

Dim conc As Worksheet
Set conc = Sheets("Pivots")

'Visible Slicers

    ThisWorkbook.SlicerCaches.Add2(conc.pivotTables("Pivot1"), _
        "[ORDER_DATA].[account_status]").Slicers.Add conc, _
        "[ORDER_DATA].[account_status].[account_status]", _
        "Account Status", "Account Status", 30, 0, 135, 90

    ThisWorkbook.SlicerCaches.Add2(conc.pivotTables("Pivot1"), _
        "[ORDER_DATA].[order_type]").Slicers.Add conc, _
        "[ORDER_DATA].[order_type].[order_type]", _
        "Order Type", "Order Type", 135, _
        0, 135, 105

    ThisWorkbook.SlicerCaches.Add2(conc.pivotTables("Pivot1"), _
        "[ORDER_DATA].[store_id]").Slicers.Add conc, _
        "[ORDER_DATA].[store_id].[store_id]", "Store ID" _
        , "Store ID", 255, 0, 135, 90

End Sub

这是我遇到的问题。尽管此方法过去已成功确保所有数据透视表都连接到相同的切片器，但它不再起作用。现在，它仅将切片器连接到第一个数据透视表，而不会在复制后连接到其余的数据透视表。我能想到的唯一解决方案是使用模块手动将所有切片器连接到所有数据透视表，这并不理想，因为这会增加仪表板生成的时间。

我可以使用更有效的方法来确保所有数据透视表都连接到相同的切片器吗？

Answer 1

• 如果在复制数据透视表之前创建切片器，则新的数据透视表应连接到切片器。我已经在 Excel 365 上测试过，没有任何问题。

• 如果由于未知原因它在您端不起作用，您可以使用以下代码将所有切片器连接到所有数据透视表。

Option Explicit

Sub demo()
    Dim Sc As SlicerCache, Pvt As PivotTable
    For Each Sc In ActiveWorkbook.SlicerCaches
        For Each Pvt In ActiveSheet.PivotTables
            Sc.PivotTables.AddPivotTable Pvt
        Next
    Next
End Sub