代码之家  ›  专栏  ›  技术社区  ›  Chris

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

  •  0
  • Chris  · 技术社区  · 7 年前

    我正在尝试打印选定预算负责人的报告(从预算负责人表中选择),使用预算负责人名称将其输入切片器,然后切片器更新各种透视表。 问题是代码选择切片器中的所有预算负责人,而不是从表中选择一个预算负责人。

    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
    
    2 回复  |  直到 7 年前
        1
  •  0
  •   QHarr    7 年前

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

    注意:它将所有表过滤器存储在一个数组中,然后循环此数组,将过滤器一次应用于与透视相关联的切片器。

    您当然希望使代码更加模块化,并将其分离成单独的函数/子函数(过滤器的存储、数组的循环和任何单独的操作,例如在循环数组时生成报告) 在手机上,所以缩进可能有点不合适。

    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,数据透视表是数据透视表1,切片器被称为切片器Budget\u Holder。

    表:

    Table

    枢轴:

    Pivottable

        2
  •  0
  •   Chris    7 年前

    我找到了一种解决方法,使用其中一个透视表而不是切片器。由于所有表都是连接的(即所有表都将预算持有人作为筛选字段并通过切片器连接),因此当预算持有人在数据透视表的数据透视字段中更新时,它将使用相同的数据透视字段值更新所有任一数据透视表。

    因此,替换原始问题中切片器代码的代码很简单:

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