从表 VBA 中选择单个切片器项目

Question

我正在尝试打印选定预算持有人的报告（从预算持有人表中选择），使用预算持有人名称输入切片器，然后更新各种数据透视表。 问题是代码选择切片器中的所有预算持有人，而不是选择我从表中选择的单个选定的预算持有人。

Sub PrintPDFsSO()

    Dim Lobj As ListObject
    Dim Budholder As String
    Dim Path As String
    Dim x As Long, y As Long, Number_of_rows As Long
    Dim SourceBk As Workbook
    Dim SlicItem As SlicerItem, SlicDummy As SlicerItem, SlicCache As SlicerCache
    Dim pt As PivotTable, wb As Workbook, ws As Worksheet

    Set SourceBk = ThisWorkbook
    Set Lobj = SourceBk.Sheets("BudHolders").ListObjects("BudHolderList")
    Set SlicCache = SourceBk.SlicerCaches("Slicer_Budget_Holder")

    For x = 1 To Lobj.DataBodyRange.Rows.Count   'Budget Holders held in    BudHolderList Table

        Dim BudHolders()
        ReDim BudHolders(1 To Lobj.DataBodyRange.Rows.Count) 'as Budholders will only ever hold one budget hodler name, can this be simpified?
        Dim Counter As Long

        Counter = 1

        If Not Lobj.DataBodyRange.Rows(x).EntireRow.Hidden Then

            Budholder = Lobj.DataBodyRange(x, 3) 'Name of budget holder held in 3rd column of Budget Holder Table

            BudHolders(Counter) = Budholder      'Budholders holds the budget holder name

            Counter = Counter + 1

            ReDim Preserve BudHolders(1 To Counter - 1)

            ' Trying to stop slicers/pivot tables calculating so code setting new filter on budget name doesnt get stuck - but not working
            Application.Calculation = xlCalculationManual

            For Each ws In SourceBk.Sheets

                For Each pt In ws.PivotTables

                    pt.ManualUpdate = True

                Next pt

            Next ws

            'Code to change budget holder in slicer to next budget holder in selection from Table
            For y = LBound(BudHolders) To UBound(BudHolders)

                With SlicCache

                    .ClearManualFilter           'clears all filters and shows all items in budget holder slicer

                    For Each SlicItem In .SlicerItems

                        If BudHolders(y) <> SlicItem.Value Then 'Tests if the slicer item matches the current a value of budholder

                            SlicItem.Selected = False 'Grinding to a virtual halt on this line as it 'calculates and populates pivot table report'

                        End If

                    Next SlicItem

                End With

            Next y

            Application.Calculation = xlCalculationAutomatic

            For Each ws In SourceBk.Sheets

                For Each pt In ws.PivotTables

                    pt.ManualUpdate = False

                Next pt

            Next ws

            'Use budholder name which will populate some graphs etc in workbook with new figures
            SourceBk.Sheets("Graphs - Summary").Range("BudHolder_SG").Value = Budholder

            'Do Printing, saving etc
        End If

    Next

End Sub

Answer 1

你能颠倒逻辑并隐藏那些不想要的吗？以下代码基于从表中提取过滤器并应用于数据透视表。

注意：它将所有表格过滤器存储在一个数组中，然后循环该数组以将过滤器一次一个地应用于与数据透视关联的切片器。

您当然希望使代码更加模块化，并分离成单独的函数/子过滤器的存储、数组的循环和任何单独的操作，例如循环数组时生成报告 在移动设备上，缩进可能有点不对。

Option Explicit

Sub PrintPDFs()

    Dim Lobj As ListObject
    Dim BudHolder As String
    Dim SlicItem As SlicerItem, SlicCache As SlicerCache
    Dim SourceBk As Workbook
    Dim x As Long

    Set SourceBk = ThisWorkbook

    'Picks up Table with budget holder details
    Set Lobj = SourceBk.Sheets("BudHolders").ListObjects("BudHolderList")

    'Picks up slicer which drives pivot tables in workbook
    Set SlicCache = SourceBk.SlicerCaches("Slicer_Budget_Holder")

    Dim BudHolders()
    ReDim BudHolders(1 To Lobj.DataBodyRange.Rows.Count)
    Dim counter As Long
    counter = 1


    For x = 1 To Lobj.DataBodyRange.Rows.Count

        If Not Lobj.DataBodyRange.Rows(x).EntireRow.Hidden Then ''Applies to items selected (ie visible) in the Budget Holder Table

            BudHolder = Lobj.DataBodyRange(x, 3)

            BudHolders(counter) = BudHolder

            counter = counter + 1

        End If

    Next x

    ReDim Preserve BudHolders(1 To counter - 1)


    For x = LBound(BudHolders) To UBound(BudHolders)

       With SlicCache

           .ClearManualFilter

           For Each SlicItem In .SlicerItems

               If BudHolders(x) <> SlicItem.Value Then

                   SlicItem.Selected = False

               End If

           Next SlicItem

       End With

       ‘Rest of code to do print PDF reports etc

    End Sub

这里的表称为 BudHolderList，pivottable 是 pivottable 1，切片器称为 Slicer_Budget_Holder。

表：

枢轴：

Answer 2

我通过使用其中一个数据透视表而不是切片器找到了一种解决方法。因为这些表都是连接的（即，所有表都将预算持有人作为过滤字段并通过切片器连接），所以当我在数据透视表的数据透视字段中更新预算持有人时，它将使用相同的 PivotField 值。

所以替换原始问题中切片器代码的代码很简单：

With sheets ("BudgetHolder").PivotTables("PivotTable1").PivotFields("BudgetHolder")
.ClearAllFilters
.CurrentPage=Budholder
End With