此代码应该做你需要的。要了解有关快速过滤数据透视表的更多信息,请查看我的blogpost on the 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 vCountries As Variant
Set pt = ActiveSheet.PivotTables("PivotTable1")
Set pf = pt.PivotFields("CountryName")
vCountries = Array("FRANCE", "BELGIUM", "LUXEMBOURG")
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 vCountries
.PivotItems(vItem).Visible = True
Next vItem
On Error GoTo 0
'Hide the first PivotItem, unless it is one of the countries of interest
On Error Resume Next
If InStr(UCase(Join(vCountries, "|")), 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
您当前的方法使用.CurrentPage属性,它是唯一相关,如果a)您透视字段是PageField(即出现在数据透视表字段列表的过滤器面板)和b)如果“选择多个项目”该字段下拉菜单中的选项未被选中。 PageField属性用于设置数据透视表以仅显示一个PivotItem。您不能使用它来显示多个项目。 – jeffreyweir
您可以确认PivotTable中PivotFIeld的位置?即它在“过滤器”区域还是“行或列”区域? – jeffreyweir