基于变量范围过滤数据透视表 [英] Filtering a Pivot Table Based on Variable Range

问题描述

我的目标是使用另一个工作表中的范围过滤数据透视表。这个范围从第三个表单中提取数据，这是数据转储，它会启动整个公式的主机，并在每次使用时进行更改。

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

任何人都可以帮助我修复代码，以便它只基于值不是空白的范围？

pre $ $ $ $ $ $ $ $ $ $' PivotTables（PivotTable2）。PivotFields（Product）
数据透视表（数据透视表）数据透视表.ClearAllFilters
End With
对于PT.PivotFields中的每个PI（Product）.PivotItems
PI.Visible = WorksheetFunction.CountIf（Sheets（Sheet1）。Range（J2： J100），
PI.Name）> 0
Next PI
Set PT = Nothing
End Sub

解决方案

你的代码在很多方面都会很慢。请阅读我关于此主题的博客帖子如果您有兴趣了解过滤数据透视表时要避免的瓶颈。

下面的代码应该让你开始。如果您有任何问题，只需填写。
$ b $ pre $ code $ Option $ Exp
$ b $ 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）
设置pf = pt.PivotFields（Product）

vList = Application.Transpose（ActiveWorkbook.Worksheets（Sheet1）。Range（J2：J100 ））

pt.ManualUpdate = True'在每个PivotItem改变之后停止数据透视表刷新

使用pf

'至少必须保留一个项目在数据透视表中任何时候都可见，所以使第一个
'项目可见，并且在例程结束时检查它是否应该是可见的
.PivotItems（1）.Visible = True

'隐藏其他尚未隐藏的项目。
'请注意，检查状态要比更改状态要快得多。
'所以只隐藏每个项目，如果它不是已经隐藏
对于i = 2到.PivotItems.Count
如果.PivotItems（i）.Visible然后.PivotItems（i）.Visible = False
下一个我

'使感兴趣的PivotItems可见
在错误恢复下一个'如果其中一个项目没有找到
For Each vItem In vList
.PivotItems（vItem）.Visible = True
Next vItem
On Error GoTo 0

'隐藏第一个PivotItem，除非它是利息
在错误恢复下一个
如果InStr（加入（vList，|）），UCase（.PivotItems（1）））= 0然后.PivotItems（1）.Visible = False
如果Err.Number<> 0然后
.ClearAllFilters
MsgBox标题：=找不到任何项目，提示符：=没有在Pivot中找到所需的项目，所以我清除了过滤器
End If
On Error Go To 0

End With

pt.ManualUpdate = False

End Sub

My objective is to filter a pivot table using a range in another sheet. This range pulls data from a 3rd sheet, which is the data dump that kicks off a whole hosts of formulas and changes every time it is used.

I have the below code but what I can see it doing is running through each Pivot Table field, comparing it to the range, and then removing the filter. I have 32,000 fields that need to be checked so the current macro is too slow to use.

Could anyone help me fix the code so that it only filters based on values in the range that are Not Blank?

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

解决方案

Your code is going to be slow on many, many counts. Have a read of my blogpost on this subject if you're interested in learning about the bottlenecks to avoid when filtering PivotTables.

The below code should get you started. If you have any questions, just holler.

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

这篇关于基于变量范围过滤数据透视表的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！