Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


14285 / 76738 ←次へ | 前へ→

【67952】Re:ピボットテーブルのフィルタ操作
発言  n  - 11/1/18(火) 20:23 -

引用なし
パスワード
   全体像が見えないので概略なアドバイスです。

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に移動して2番目の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秒前後で処理できると思います。

6 hits

【67708】ピボットテーブルのフィルタ操作 H=R 10/12/29(水) 14:12 質問
【67795】Re:ピボットテーブルのフィルタ操作 n 11/1/8(土) 22:50 発言
【67930】Re:ピボットテーブルのフィルタ操作 H=R 11/1/17(月) 18:45 質問
【67933】Re:ピボットテーブルのフィルタ操作 n 11/1/17(月) 19:39 発言
【67943】Re:ピボットテーブルのフィルタ操作 H=R 11/1/18(火) 14:29 お礼
【67952】Re:ピボットテーブルのフィルタ操作 n 11/1/18(火) 20:23 発言
【67969】Re:ピボットテーブルのフィルタ操作 H=R 11/1/19(水) 21:28 お礼
【67970】Re:ピボットテーブルのフィルタ操作 H=R 11/1/19(水) 23:50 質問
【67971】Re:ピボットテーブルのフィルタ操作 n 11/1/20(木) 0:38 発言
【67972】Re:ピボットテーブルのフィルタ操作 H=R 11/1/20(木) 8:55 お礼

14285 / 76738 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free