excel2003のピヴォットテーブル

質問

excel2003を利用しています。

ＰＶＴ_graphという名前のシートに複数のピヴォットテーブルがあります。
それぞれのピヴォットテーブルの参照先データは全て同じです。

ページフィールドをそれぞれ同じ値に変更する手間を省くために、
vbaで一括して変更するようにしていますが、

該当するピヴォットアイテムがない場合に、今選択されているアイテム
をリストで選択した値に変更してしまいます。

リストとは、違うシートに入力規則で１～１２の値を登録していますが、
ピヴォットテーブル側では、１～１２全てに対して、ピヴォットアイテムがないのです。

下記、VBAの記述に対して、どのような修正を加えれば、ピヴォットアイテムがない場合に
リストで選択した値に変更しないようにできるでしょうか？

Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False

If Target.Address = "$G$1" Then

For Each pvt_tbl In Worksheets("PVT_graph").PivotTables
pvt_tbl.PivotFields("月").CurrentPage = Target.Value
Cancel = True
Next

ElseIf Target.Address = "$E$1" Then

For Each pvt_tbl In Worksheets("PVT_graph").PivotTables
pvt_tbl.PivotFields("年").CurrentPage = Target.Value
Cancel = True
Next
Application.ScreenUpdating = True
ThisWorkbook.RefreshAll

End If

End Sub

回答No.1

keithin · ベストアンサー

＞それぞれのピヴォットテーブルの参照先データは全て同じです。

このご説明から，各テーブルはフィールド（＝アイテム）をデータ共有できてるとします

＞ピヴォットアイテムがない場合にリストで選択した値に変更しないようにできるでしょうか

リストで選択した値(1から12)を間違い無くTarget.valueで取得できてる所から

dim pfi as pivotitem
dim flg as boolean
for each pfi in activesheet.pivottables(1).pagefields(1).pivotitems
if pfi.value = trim(str(target.value)) then
flg = true
exit for
end if
next
if not flg then msgbox "NOT EXIST" : end

お礼

keithin様
回答ありがとうございます。
頂いた記述を参考にして、見事に上手くいきました。
これは無理なのではないか。と半ば諦めていただけに、
喜びがとても大きかったです。
本当にありがとうございました。