| |
全体像が見えないので概略なアドバイスです。
A案）
元データの隣接列にFLAGフィールドを追加、Pivot元データ範囲も拡張させる。
FLAGフィールドには表示させたいItemだけ TRUE。
そのFLAGフィールドをPageFieldに使う。
Sub sample1() 'FLAGフィールドに判定のTRUE/FALSEをセットする例。
Const Lst = ",部署1,部署2,部署3," '表示させるItemリストを","で囲む
Dim v
Dim w() As Boolean
Dim x As Long
Dim i As Long
With Range("A1").CurrentRegion
'部署名フィールドがA列なら
v = Intersect(.Offset(1), .Columns("A")).Value
End With
x = UBound(v)
ReDim w(1 To x, 0)
For i = 1 To x
w(i, 0) = (InStr(Lst, "," & v(i, 1) & ",") > 0)
Next
'FLAGフィールドがF列なら
Range("F2").Resize(x).Value = w
End Sub
B案）
【65195】の応用で、PageFieldからRowFieldに移動して２番目のItem以降をまとめて非表示。
その後目的のItemをVisible = Trueにした後に先頭のItemをVisible = False。
設定後にRowFieldからPageFieldに戻す。
Sub sample2()
Const Trg = "フィールド名" 'ページフィールド名
Const Lst = "部署1,部署2,部署3" '表示させるItemリストをカンマ区切り文字列で
Dim pf As PivotField
Dim r As Range
Dim rr As Range
Dim x As String
Dim s() As String
Dim si
With ActiveSheet.PivotTables(1)
On Error Resume Next
Set pf = .PivotFields(Trg)
pf.ClearAllFilters
pf.Orientation = xlRowField
pf.Position = 1
Set r = Intersect(pf.DataRange, .RowRange)
On Error GoTo 0
If Not r Is Nothing Then
Set rr = r.Find(pf.PivotItems(2), , xlValues, xlWhole, , , , False)
If Not rr Is Nothing Then
x = pf.PivotItems(1)
Range(rr, r(r.Count)).Delete
s = Split(Lst, ",")
For Each si In s
pf.PivotItems(si).Visible = True
Next
If IsError(Application.Match(x, s, 0)) Then
pf.PivotItems(1).Visible = False
End If
End If
End If
pf.Orientation = xlPageField
End With
Set pf = Nothing
Set rr = Nothing
Set r = Nothing
End Sub
元データの量にもよるかもしれませんが
1,000アイテム程度であれば1秒前後で処理できると思います。
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
