EXCEL2007 VBAでピボットのフィルタ指定

質問

EXCEL 2007 VBAでピボットテーブルを生成しようとしております。

レポートフィルタで初期表示するデータフィールド「メーカー」の値も
指定できればと思っております。

「メーカー」には今回データで「A」「B」「C」「D」「E」とあったとして
「メーカー」 ... 「A」と「C」だけで表示指定したいとして、
下記操作で記録マクロを取ってみました。

1. レポートフィルタ「メーカー」を追加
2. フィルタ条件で「（すべて）」のチェック外して、全て消す。
3. 「メーカー」　... 「A」と「C」を指定

結果は希望通りなのですが、
記録マクロを確認すると下記のように「A」と「C」で指定できておりません。

これだとメーカー「F」のデータが追加された際、
希望通りでないと思うのですが、良い方法をどなたかご存じないでしょうか？

ActiveSheet.PivotTables("数量予測").PivotFields("メーカー").CurrentPage = "(All)"
With ActiveSheet.PivotTables("数量予測").PivotFields("メーカー")
.PivotItems("B").Visible = False
.PivotItems("D").Visible = False
.PivotItems("E").Visible = False
End With

回答No.1

end-u · ベストアンサー

Ver2007でClearAllFiltersメソッドが追加されました。
繰り返して使う場合も想定して、ClearAllFiltersで一旦全表示にします。
その後、表示したいアイテムを指定して、それ以外（Case Else）は非表示、
という処理で良いかと思います。

Sub try()
　　Dim pf As PivotField
　　Dim p　As PivotItem

　　Set pf = ActiveSheet.PivotTables("数量予測").PivotFields("メーカー")
　　pf.Orientation = xlPageField
　　pf.ClearAllFilters
　　For Each p In pf.PivotItems
　　　　Select Case p.Value
　　　　Case "A", "C" '表示アイテム名をカンマ区切りで指定
　　　　Case Else
　　　　　　p.Visible = False
　　　　End Select
　　Next
End Sub

Ver2007以降でないと動作しません。
2003でも使う可能性があるなら以下のようにPageFieldを再配置。
但し、再配置前に更新する必要があります。

Sub try_2()
　　Dim pf As PivotField
　　Dim p　As PivotItem

　　Set pf = ActiveSheet.PivotTables("数量予測").PivotFields("メーカー")
　　pf.Orientation = xlHidden
　　pf.Parent.PivotCache.Refresh
　　pf.Orientation = xlPageField
　　For Each p In pf.PivotItems
　　　　Select Case p.Value
　　　　Case "A", "C" '表示アイテム名をカンマ区切りで指定
　　　　Case Else
　　　　　　p.Visible = False
　　　　End Select
　　Next
End Sub

お礼

ありがとうございます！望みどおりに出力することが出来ました！！
ループ処理で指定値でなければ、非表示にするとは考え及びませんでした。

検証・御礼が遅くなり申し訳ございません。

一番目のコードを使わせていただきます。

Excel2003化を渋っている人間がいるので、
これを人質にバージョンアップさせることも出来るので大助かりです。

回答No.2

end-u

ぁ、そうだ。
PivotFields("メーカー")のItem数が数百を超える場合は
１件ずつ非表示にしていくとワークシート表示がもたついてかなり遅いです。
その場合、Application.ScreenUpdatingプロパティで表示を制御してください。

それでも遅い場合は、一旦RowFieldに配置してまとめて処理します。
１個だけ仮表示アイテムとして残してそれ以外まとめて非表示にし、
表示アイテムの処理をした後にPageFieldに配置するような感じです。

ちょっと難解かもしれませんが書いておきますね。

Sub try_3()
　　Const Lst = "A,C" '表示アイテム名をカンマ区切りで指定
　　Dim pf　As PivotField
　　Dim r　 As Range
　　Dim n　 As Long
　　Dim x　 As String
　　Dim s() As String
　　Dim si

　　Application.ScreenUpdating = False
　　Set pf = ActiveSheet.PivotTables("数量予測").PivotFields("メーカー")
　　'行フィールドに配置
　　pf.Orientation = xlRowField
　　'最左列配置
　　pf.Position = 1
　　Set r = pf.DataRange
　　'データ範囲の1つめのセルを仮表示アイテムとして値を記憶
　　x = r.Item(1).Value
　　n = r.Cells.Count - 1
　　If n > 0 Then
　　　　'仮表示アイテムだけ残してまとめて非表示
　　　　r.Resize(n).Offset(1).Delete
　　End If
　　'表示アイテム処理
　　s = Split(Lst, ",")
　　On Error Resume Next
　　For Each si In s
　　　　pf.PivotItems(si).Visible = True
　　Next
　　On Error GoTo 0
　　'記憶しておいた仮表示アイテムの処理
　　If IsError(Application.Match(x, s, 0)) Then
　　　　pf.PivotItems(x).Visible = False
　　End If
　　'ページフィールドに配置
　　pf.Orientation = xlPageField
　　Application.ScreenUpdating = True
End Sub