アプリ版:「スタンプのみでお礼する」機能のリリースについて

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

PivotTables("ピボット")にて フィルタで初期表示するデータフィールド「担当者」の値を別途シートのセルで指定できればと思っております。

「担当者」には今回データで「A」「B」「C」「D」「E」、、、、合計約100人の名前があったとして 複数の担当者名を表示指定したいとして、その担当者名は、別シート「MAIN]のセルA1~A15に入力されている名前を使用したい

以前の回答からヒントをもらい下記のようなマクロをイメージしてますが、うまくいきません。セルの値でのピボットフィルタ指定のVBAについて教えてください。


※過去アンサーより抜粋
PivotFields("メーカー")のItem数が数百を超える場合は、1件ずつ非表示にしていくとワークシート表示がもたついてかなり遅い。その場合、Application.ScreenUpdatingプロパティで表示を制御、それでも遅い場合は、一旦RowFieldに配置してまとめて処理。 1個だけ仮表示アイテムとして残してそれ以外まとめて非表示にし、表示アイテムの処理をした後に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

A 回答 (1件)

まぁ~初級レベルなジジィなので違っても当然かもですが。



内容が良くわからなかったので検証はしてません。
不安であれば無視して下さい。
またエラーになるようならお手上げです。(憶測なので)
-----

Sub try_4()
'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 s , 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, ",")
With Worksheets("MAIN")
s = Application.Transpose(.Range("A1", .Cells(Rows.Count, 1).End(xlUp)).Value)
End With

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
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています


このQ&Aを見た人がよく見るQ&A