根据变量范围过滤数据透视表答案

【问题标题】：Filtering a Pivot Table Based on Variable Range根据变量范围过滤数据透视表
【发布时间】：2018-03-11 06:03:45
【问题描述】：

我的目标是使用另一个工作表中的范围过滤数据透视表。此范围从第三张表中提取数据，这是启动大量公式并在每次使用时都会更改的数据转储。

我有以下代码，但我可以看到它正在运行每个数据透视表字段，将其与范围进行比较，然后删除过滤器。我有 32,000 个字段需要检查，因此当前的宏使用起来太慢了。

谁能帮我修复代码，使其仅根据非空白范围内的值进行过滤？

Sub PT()
Dim PT As PivotTable
Dim PI As PivotItem
Set PT = Sheets("Pivot_Sheet").PivotTables("PivotTable2")
With Sheets("Pivot_Sheet").PivotTables("PivotTable2").PivotFields("Product")
.ClearAllFilters
End With
For Each PI In PT.PivotFields("Product").PivotItems
PI.Visible = WorksheetFunction.CountIf(Sheets("Sheet1").Range("J2:J100"),
PI.Name) > 0
Next PI
Set PT = Nothing
End Sub

【问题讨论】：

请将您的代码放入代码标签中。
抱歉，已标记代码。

标签： excel filter pivot-table vba

【解决方案1】：

您的代码在很多方面都会很慢。如果您有兴趣了解过滤数据透视表时要避免的瓶颈，请阅读我的blogpost on this subject。

下面的代码应该可以帮助您入门。如果您有任何问题，请大声喊叫。

Option Explicit

Sub FilterPivot()
Dim pt As PivotTable
Dim pf As PivotField
Dim pi As PivotItem
Dim i As Long
Dim vItem As Variant
Dim vList As Variant

Set pt = ActiveSheet.PivotTables("PivotTable2")
Set pf = pt.PivotFields("Product")

vList = Application.Transpose(ActiveWorkbook.Worksheets("Sheet1").Range("J2:J100"))

pt.ManualUpdate = True 'Stops PivotTable from refreshing after each PivotItem is changed

With pf

    'At least one item must remain visible in the PivotTable at all times, so make the first
    'item visible, and at the end of the routine, check if it actually  *should* be visible
    .PivotItems(1).Visible = True

    'Hide any other items that aren't already hidden.
    'Note that it is far quicker to check the status than to change it.
    ' So only hide each item if it isn't already hidden
    For i = 2 To .PivotItems.Count
        If .PivotItems(i).Visible Then .PivotItems(i).Visible = False
    Next i

    'Make the PivotItems of interest visible
    On Error Resume Next 'In case one of the items isn't found
    For Each vItem In vList
        .PivotItems(vItem).Visible = True
    Next vItem
    On Error GoTo 0

    'Hide the first PivotItem, unless it is one of the items of interest
    On Error Resume Next
    If InStr(UCase(Join(vList, "|")), UCase(.PivotItems(1))) = 0 Then .PivotItems(1).Visible = False
    If Err.Number <> 0 Then
        .ClearAllFilters
        MsgBox Title:="No Items Found", Prompt:="None of the desired items was found in the Pivot, so I have cleared the filter"
    End If
    On Error GoTo 0

End With

pt.ManualUpdate = False

End Sub

【讨论】：