■PivotItems().Visible = True|False

PivotTablesをVBAで操作する時の話。
RowFieldsやColumnFieldsの特定のPivotItemsだけ表示したい場合、
全Itemを一旦表示させて、目的のItem以外をVisible = Falseにする、という処理が考えられます。
PivotItemsをLoopして、目的ItemだったらTrue、それ以外はFalse..という処理だと
全Item非表示になるタイミングがあった時にエラーになるからです。
でも、Ver.2007以降ClearAllFiltersメソッドが追加され、全Item表示が楽になったとはいえ、やはり効率は悪いです。

なので前回記事のリンク先
『マクロでピボットのPivotItemsのVisible = Trueができない』
http://park7.wakwak.com/~efc21/cgi-bin/exqalounge.cgi?print+201209/12090023.txt
ここでは

Sub try()
　　Const Trg = "F1"　　　　　　　　'フィールド名
　　Const Lst = "item0001,item0002" '表示させるItemリスト
　　Dim pf As PivotField
　　Dim i　As Long
　　Dim x　As String
　　Dim s, si

　　Set pf = ActiveSheet.PivotTables(1).PivotFields(Trg)
　　pf.AutoSort xlManual, ""
　　With pf.VisibleItems
　　　　x = .Item(1).Value
　　　　For i = 2 To .Count
　　　　　　.Item(i).Visible = False
　　　　Next
　　End With
　　s = Split(Lst, ",")
　　For Each si In s
　　　　pf.PivotItems(si).Visible = True
　　Next
　　If IsError(Application.Match(x, s, 0)) Then
　　　　pf.PivotItems(x).Visible = False
　　End If

　　Set pf = Nothing
End Sub

こんなVisibleItemsのみをLoopするようなコードも提示してます。
>効率考えればHiddenItemsを一旦表示させるより
>VisibleItemsの中から１コだけ残して非表示にし、
>目的のItemを表示させるほうが良い..


ただ、リンク先にも書いているように、
全表示から処理する場合、特にItem数が多いとPivotItems().Visible = False はかなり遅くなります。
そういう場合は
>..非表示にしたい行フィールド内のセルを選択して右クリック[表示しない]..
PivotFields().DataRange に対して Deleteメソッドを使うと速く処理できます。

ちょっと計測してみました。

（実行後のイメージ）


テスト　　　　　　ScreenUpdating　　Time
try_1(Loop方式)　　　　True　　　　332.4531
try_1(Loop方式)　　　　False　　　 228.8594
try_2(Delete方式)　　　True　　　　　0.28125
try_2(Delete方式)　　　False　　　　 0.125

以下、テストコード。

Option Explicit

Sub pre() '準備--テストBook作成--
　　Const x = 8001 '97での限界値(?)
　　With Workbooks.Add(xlWBATWorksheet).Sheets(1)
　　　　.Range("A1:B2").Value = [{"F1","F2";"item0001",1}]
　　　　.Range("A2:B2").AutoFill .Range("A2:B" & x), xlFillSeries
　　　　With .PivotTableWizard(xlDatabase, "'" & .Name & "'!A1:B" & x, "")
　　　　　　.PivotFields("F1").Orientation = xlRowField
　　　　　　.PivotFields("F2").Orientation = xlDataField
　　　　End With
　　End With
End Sub
'-------------------------------------------------
Sub test() 'テスト
　　Dim n As Long:　　n = 2　　'テストプロシージャ指定
　　Dim b As Boolean: 'b = True 'ScreenUpdating指定
　　Dim t As Single

　　try_0 '条件揃えるため、一応..
　　Application.ScreenUpdating = b
　　t = Timer
　　Select Case n
　　Case 1: try_1
　　Case 2: try_2
　　End Select
　　Debug.Print "try_" & n, b, Timer - t
　　Application.ScreenUpdating = True
End Sub
'-------------------------------------------------
Private Sub try_1() 'Loop方式
　　Dim pf As PivotField
　　Dim p　As PivotItem

　　Set pf = ActiveSheet.PivotTables(1).PivotFields("F1")
　　pf.Orientation = xlHidden
　　pf.Parent.PivotCache.Refresh
　　pf.Orientation = xlRowField
　　For Each p In pf.PivotItems
　　　　Select Case p.Value
　　　　Case "item4000", "item8000" '表示アイテム名をカンマ区切りで指定
　　　　Case Else
　　　　　　p.Visible = False
　　　　End Select
　　Next
　　Set pf = Nothing
End Sub
'-------------------------------------------------
Private Sub try_2() 'Delete方式
　　Const Lst = "item4000,item8000" '表示アイテム名をカンマ区切りで指定
　　Dim pf　As PivotField
　　Dim r　 As Range
　　Dim n　 As Long
　　Dim x　 As String
　　Dim s
　　Dim si

　　Set pf = ActiveSheet.PivotTables(1).PivotFields("F1")
　　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 = fSplit(Lst, ",")
　　'pf.AutoSort xlManual, ""
　　On Error Resume Next
　　For Each si In s
　　　　pf.PivotItems(si).Visible = True
　　Next
　　'記憶しておいた仮表示アイテムの処理
　　If IsError(Application.Match(x, s, 0)) Then
　　　　pf.PivotItems(x).Visible = False
　　End If
　　On Error GoTo 0
　　Set pf = Nothing
End Sub
'-------------------------------------------------
Function fSplit(ByVal s As String, ByVal t As String) '97用
　　Dim n As Long
　　Dim i As Long
　　Dim p As Long

　　n = Len(s)
　　ReDim ss(n) As String
　　p = 1
　　For i = 0 To n
　　　　n = InStr(p, s, t)
　　　　If n = 0 Then
　　　　　　ss(i) = Mid$(s, p)
　　　　　　Exit For
　　　　End If
　　　　ss(i) = Mid$(s, p, n - p)
　　　　p = n + Len(t)
　　Next
　　ReDim Preserve ss(i)
　　fSplit = ss
End Function
'-------------------------------------------------
Private Sub try_0()
　　Dim pf As PivotField
　　Dim p　As PivotItem

　　Set pf = ActiveSheet.PivotTables(1).PivotFields("F1")
　　pf.Orientation = xlHidden
　　pf.Parent.PivotCache.Refresh
　　pf.Orientation = xlRowField
End Sub