Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
2927 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【65160】PivotItemsについて 椿 10/4/20(火) 21:15 質問[未読]
【65181】Re:PivotItemsについて n 10/4/23(金) 22:26 発言[未読]
【65188】Re:PivotItemsについて 椿 10/4/24(土) 22:47 質問[未読]
【65195】Re:PivotItemsについて n 10/4/26(月) 16:16 発言[未読]
【65236】Re:PivotItemsについて 椿 10/4/28(水) 22:54 お礼[未読]
【65160】PivotItemsについて
質問  椿  - 10/4/20(火) 21:15 -
引用なし
パスワード
   更新した後に、PivotItemsで選択しているのですが、新しいアイテムが増えるとそれまで勝手に選択されてしまいます。PivotItems時にゼロベースからアイテムを選択できないのでしょうか？ループすることで改善させてはいますが、アイテムが多く時間がかかってしまいます。何かほかにアイデアがあれば、アドバイスいただけたらと思います。
【65181】Re:PivotItemsについて
発言  n  - 10/4/23(金) 22:26 -
引用なし
パスワード
   >PivotItems時にゼロベースから...
全アイテムを非選択（非表示）にはできないです。
Loopで時間がかかるなら、Deleteを使ってみてください。

例えば先頭の１コだけ残す例。
Sub try()
　　Const p = 3
　　Dim x As Long

　　With ActiveSheet.PivotTables(1)
　　　　If Not .ColumnGrand Then x = 1
　　　　With .RowRange.Columns(1).Cells
　　　　　　.Item(p).Resize(.Count - p + x).Delete
　　　　End With
　　End With
End Sub

列方向の場合は
Const p = 2
Dim x As Long

With ActiveSheet.PivotTables(1)
　　If Not .RowGrand Then x = 1
　　With .ColumnRange.Rows(2).Cells
　　　　.Item(p).Resize(, .Count - p + x).Delete
　　End With
End With


更新前後のCountを比較して増えたItemだけ非表示にするなら
Dim p As Long
Dim x As Long
Dim n As Long

With ActiveSheet.PivotTables(1)
　　If Not .ColumnGrand Then x = 1
　　p = .RowRange.Columns(1).Cells.Count
　　.RefreshTable
　　With .RowRange.Columns(1).Cells
　　　　n = .Count - p
　　　　If n > 0 Then
　　　　　　.Item(p + x).Resize(n).Delete
　　　　End If
　　End With
End With
#更新前に選択していたItemが無くなる事がある場合は使えません。
【65188】Re:PivotItemsについて
質問  椿  - 10/4/24(土) 22:47 -
引用なし
パスワード
   n　様ありがとうございます。

更新後でアイテムが変わる場合があるので、最初のを試してみようと思っているのですが、Deleteで先頭の一つだけ残し、その後PivotItemsで指定のアイテムを選択。その後先頭のアイテムを取得して削除などは、可能なのでしょうか。


▼n さん：
>>PivotItems時にゼロベースから...
>全アイテムを非選択（非表示）にはできないです。
>Loopで時間がかかるなら、Deleteを使ってみてください。
>
>例えば先頭の１コだけ残す例。
>Sub try()
>　　Const p = 3
>　　Dim x As Long
>
>　　With ActiveSheet.PivotTables(1)
>　　　　If Not .ColumnGrand Then x = 1
>　　　　With .RowRange.Columns(1).Cells
>　　　　　　.Item(p).Resize(.Count - p + x).Delete
>　　　　End With
>　　End With
>End Sub
>
>列方向の場合は
>Const p = 2
>Dim x As Long
>
>With ActiveSheet.PivotTables(1)
>　　If Not .RowGrand Then x = 1
>　　With .ColumnRange.Rows(2).Cells
>　　　　.Item(p).Resize(, .Count - p + x).Delete
>　　End With
>End With
>
>
>更新前後のCountを比較して増えたItemだけ非表示にするなら
>Dim p As Long
>Dim x As Long
>Dim n As Long
>
>With ActiveSheet.PivotTables(1)
>　　If Not .ColumnGrand Then x = 1
>　　p = .RowRange.Columns(1).Cells.Count
>　　.RefreshTable
>　　With .RowRange.Columns(1).Cells
>　　　　n = .Count - p
>　　　　If n > 0 Then
>　　　　　　.Item(p + x).Resize(n).Delete
>　　　　End If
>　　End With
>End With
>#更新前に選択していたItemが無くなる事がある場合は使えません。
【65195】Re:PivotItemsについて
発言  n  - 10/4/26(月) 16:16 -
引用なし
パスワード
   Sub try()
　　Const Trg = "F1"　　'フィールド名
　　Const Lst = "A,B,C" '表示させるitemリスト
　　Dim pf As PivotField
　　Dim r　As Range
　　Dim x　As Long
　　Dim v, s, si

　　With ActiveSheet.PivotTables(1)
　　　　.RefreshTable
　　　　On Error Resume Next
　　　　Set pf = .PivotFields(Trg)
　　　　Set r = Intersect(pf.DataRange, .RowRange)
　　　　On Error GoTo 0
　　　　If Not r Is Nothing Then
　　　　　　v = r.Item(1).Value
　　　　　　x = r.Count - 1
　　　　　　If x > 1 Then
　　　　　　　　r.Resize(x).Offset(1).Delete
　　　　　　End If
　　　　　　s = Split(Lst, ",")
　　　　　　For Each si In s
　　　　　　　　pf.PivotItems(si).Visible = True
　　　　　　Next
　　　　　　If IsError(Application.Match(v, s, 0)) Then
　　　　　　　　pf.PivotItems(v).Visible = False
　　　　　　End If
　　　　End If
　　End With

　　Set pf = Nothing
　　Set r = Nothing
End Sub
..こんな感じです。
【65236】Re:PivotItemsについて
お礼  椿  - 10/4/28(水) 22:54 -
引用なし
パスワード
   ｎ　様　ありがとうございます。現在のマクロと比べて試してみようと思います。
ちなみに現在は、下記マクロを利用しています。

ActiveS heet.PivotTables("ﾋﾟﾎﾞｯﾄﾃｰﾌﾞﾙ1").PivotCache.Refresh
　 On Error Resume Next
　　Dim pivF As PivotField, pivi As PivotItem
　　Set pivF = ActiveSheet.PivotTables("ﾋﾟﾎﾞｯﾄﾃｰﾌﾞﾙ1").PivotFields("中分類コード")
　　For Each pivi In pivF.PivotItems
　　Select Case pivi.Caption
　　　　Case "2151", "2153", "2154", "2155"
　　　　pivi.Visible = True
　　　　Case Else
　　　　pivi.Visible = False
　　　　End Select
　 Next

ﾋﾟﾎﾞｯﾄﾃｰﾌﾞﾙが10個ぐらいあり、それぞれのﾋﾟﾎﾞｯﾄﾃｰﾌﾞﾙごとに中分類コードが異なり、それぞれループしているので、マクロ終了するまで5分ぐらいはかかってしまします。上記マクロの改善点があれば、アドバイスをいただけたらと思います。


▼n さん：
>Sub try()
>　　Const Trg = "F1"　　'フィールド名
>　　Const Lst = "A,B,C" '表示させるitemリスト
>　　Dim pf As PivotField
>　　Dim r　As Range
>　　Dim x　As Long
>　　Dim v, s, si
>
>　　With ActiveSheet.PivotTables(1)
>　　　　.RefreshTable
>　　　　On Error Resume Next
>　　　　Set pf = .PivotFields(Trg)
>　　　　Set r = Intersect(pf.DataRange, .RowRange)
>　　　　On Error GoTo 0
>　　　　If Not r Is Nothing Then
>　　　　　　v = r.Item(1).Value
>　　　　　　x = r.Count - 1
>　　　　　　If x > 1 Then
>　　　　　　　　r.Resize(x).Offset(1).Delete
>　　　　　　End If
>　　　　　　s = Split(Lst, ",")
>　　　　　　For Each si In s
>　　　　　　　　pf.PivotItems(si).Visible = True
>　　　　　　Next
>　　　　　　If IsError(Application.Match(v, s, 0)) Then
>　　　　　　　　pf.PivotItems(v).Visible = False
>　　　　　　End If
>　　　　End If
>　　End With
>
>　　Set pf = Nothing
>　　Set r = Nothing
>End Sub
>..こんな感じです。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
2927 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free