ピボットフィールド複数のフィルタ

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