Pivotfields 多重过滤器

Question

我有下面的代码，我试图让我的数据透视表的数据透视表部分显示 3 个国家（法国、比利时和卢森堡）。每次更新表格时，国家列表都会扩展和收缩（但法国、比利时和卢森堡仍然存在）。

'delete all filters for country
  With ActiveSheet.PivotTables("PivotTable1").PivotFields("countryName")
  .ClearAllFilters
  .CurrentPage = "FRANCE"
  .PivotItems("BELGIUM").Visible = True
  .PivotItems("LUXEMBOURG").Visible = True

  End With

这不起作用，现在出现的代码有问题（错误），但比利时和卢森堡没有出现在过滤列表中

有人可以帮忙吗？

Answer 1

此代码应该可以满足您的需求。要了解有关快速过滤数据透视表的更多信息，请查看我的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