Excel､VBAでピボットテーブル、pagefieldの絞込み

添付ピボットテーブルでpagefieldの2019/04～2020/03迄に絞込みするには以下コードをどう修正すればいいでしょうか宜しく御願いします。
Sub Sample()
Range("A3").Select
Dim D As Range
Set D = ActiveCell.CurrentRegion
Sheets.Add

ActiveWorkbook.PivotCaches.Add(xlDatabase, D).CreatePivotTable _
Range("A3")
With ActiveSheet.PivotTables(1)
.PivotFields("販売月").Orientation = xlPageField
.PivotFields("店名").Orientation = xlRowField
.PivotFields("品名").Orientation = xlColumnField
.PivotFields("金額").Orientation = xlDataField
End With
Range("A3").Activate

'ここからのコードが？です。Field:=3は3列目の意味なので間違い
ActiveSheet.AutoFilterMode = False
Dim 期間1 As String
Dim 期間2 As String
期間1 = InputBox("ﾃﾞｰﾀ抽出開始日を入力してください。（2017/1/1形式で入力）")
期間2 = InputBox("ﾃﾞｰﾀ抽出終了日を入力してください。（2017/1/1形式で入力）")
Range("A3").AutoFilter Field:=3, _
Criteria1:=">=" & 期間1, _
Operator:=xlAnd, _
Criteria2:="<=" & 期間2
End Sub

質問者からの補足コメント

• 例えば8行目に"店名"Z､"品名"か､"販売月"空欄､"金額"70､が有った場合、"販売月"空欄もピボットに表示されてしまいます。空欄は表示されず2019/04～2020/03のみとするにはどうしたらいいでしょうか。

  No.2の回答に寄せられた補足コメントです。 補足日時：2020/03/28 00:40

No.2 ベストアンサー 回答者： Qchan1962 回答日時： 2020/03/25 00:22

回答時時間がなかったのですが、解説を加えますね。

With ActiveSheet.PivotTables(1).PivotFields("販売月")
　　.PivotFilters.Add2 Type:=xlDateBetween, Value1:="2019/2/1", Value2:="2019/8/1"
End With
については、PivotFilters メソッドのパラメータTypeに日付の範囲があったと記憶していたので
https://docs.microsoft.com/ja-jp/office/vba/api/ …　を確認して
https://docs.microsoft.com/ja-jp/office/vba/api/ …　を参考に書いてみましたが
検証した時に確か1004エラーが返ったので、あまり追求せず（あまり時間がなかったので）べたにitm要素を
検証してVisible設定をする方法にしました。したがって、xlDateBetweenで実行する方法もあると思います。

まず、
　　Do　’繰り返し処理
　　　　期間1 = InputBox("ﾃﾞｰﾀ抽出開始日を入力してください。（2017/1/1形式で入力）")
　　　　If StrPtr(期間1) = 0 Then Exit Sub　’キャンセル時、終了する
　　　　If IsDate(期間1) Then flg = True　’期待する形式であったらflgを設定して繰り返し処理から抜ける。
　　Loop Until flg = True
については、InputBoxの入力形式指定を無視した入力の場合を想定して値が日付に該当するかを検証しています。

If IsDate(期間1) Then flg = Trueの部分は、Elseなどを加える事でMsgboxなどを出す事も出来ると思います。
例：
If IsDate(期間1) Then
flg = True
Else
Msgbox("入力に不備があります。ﾃﾞｰﾀ抽出開始日を2017/1/1形式で入力してください")
End if

こちらが本題です
For Each itm In ActiveSheet.PivotTables(1).PivotFields("販売月").PivotItems　は、文字通り
作成されたピボットのフィールド"販売月"のPivotItems　アイテムすべてに対して1つずつループで　itm（変数）に代入しています。

代入されたitmの中身をIsDate(itm)　でInputBox同様に検証して、Date型に出来るならsDate = CDate(itm)で
型変換（Date型）して変数sDateに代入しています。
（今、気づきましたがsDateは分かり難くなる可能性があるので変数名を変えた方が良いかも）
sDateと期間（変数）を比較演算子、論理演算子で解を求め、該当　itmに対しVisible設定しています。

If Not IsDate(itm) Then GoTo sp　は、作成された該当セルの値が日付に出来ない場合などのエラーを防ぐ為
該当しない場合、そのアイテムに対して処理を飛ばしています。
データの内容が、絶対の値（事前に検証、設定されているの）であれば、必要はないと思います。

つまり、必要部分は（itmが文字列の場合）
　　For Each itm In ActiveSheet.PivotTables(1).PivotFields("販売月").PivotItems
　　　　If CDate(itm) >= 期間1 And CDate(itm) <= 期間2 Then
　　　　　　itm.Visible = True
　　　　Else
　　　　　　itm.Visible = False
　　　　End If
　　Next itm

また、Date型に変更する理由は、文字列だと比較できない為です

この回答へのお礼

詳細な回答をいただき有難う御座います。理解する為に確認させていただきます。

お礼日時：2020/03/25 23:38

No.4 回答者： Qchan1962 回答日時： 2020/03/28 02:10

回答ボタンを押してしまいました。

For Each itm In ActiveSheet.PivotTables(1).PivotFields("販売月").PivotItems
の後に
Debug.Print itm.Value
イミディエイトウィンドウなどで値を確認して対応するなど考えるようにしましょう。
ただ、力業の分類になる場合もありますが、、

と、見直すと＃３はダメ問題ありますね

下記にしてください。すみません。

　　For Each itm In ActiveSheet.PivotTables(1).PivotFields("販売月").PivotItems
　　　If Not IsDate(itm) Or itm.Value = "(blank)" Then
　　　　itm.Visible = False
　　　　GoTo sp
　　　End If

この回答へのお礼

回答有難う御座います。
力不足でNo.1とNo.3の違いに朝から悩んでいました。結果以下で動きました。有難う御座います。
For Each itm In ActiveSheet.PivotTables(1).PivotFields("販売月").PivotItems
If Not IsDate(itm) Or itm.Value = "(blank)" Then
itm.Visible = False
Else
If Not IsDate(itm) Then GoTo sp
sDate = CDate(itm)
If sDate >= 期間1 And sDate <= 期間2 Then
itm.Visible = True
Else
itm.Visible = False
End If
End If
sp:
Next itm

お礼日時：2020/03/28 20:42

No.3 回答者： Qchan1962 回答日時： 2020/03/28 01:52

＞絞込みするには　の範疇で良いですよね。

For Each itm In ActiveSheet.PivotTables(1).PivotFields("販売月").PivotItems
　　If itm.Value = "(blank)" Then itm.Visible = False
　　If Not IsDate(itm) Or itm.Value = "(blank)" Then GoTo sp

しかし、データの内容からしてそのようなデータが存在するのは、どうでしょう？

No.1 回答者： Qchan1962 回答日時： 2020/03/24 16:33

作成されたActiveSheet.PivotTables(1)の名前：販売月に期間でフィルタを掛けたいのだと解釈しました。

With ActiveSheet.PivotTables(1).PivotFields("販売月")
　　.PivotFilters.Add2 Type:=xlDateBetween, Value1:="2019/2/1", Value2:="2019/8/1"
End With
こんな感じで出来たような気がして書いてみましたが、どうもダメ見たいで、、すんなりあきらめ
便利機能でなく、べたにやる方法を考えました。。

参考

　　Dim 期間1 As String, 期間2 As String
　　Dim flg As Boolean
　　Dim itm As PivotItem, sDate As Date
　　Do
　　　　期間1 = InputBox("ﾃﾞｰﾀ抽出開始日を入力してください。（2017/1/1形式で入力）")
　　　　If StrPtr(期間1) = 0 Then Exit Sub
　　　　If IsDate(期間1) Then flg = True
　　Loop Until flg = True
　　Do
　　　　期間2 = InputBox("ﾃﾞｰﾀ抽出開始日を入力してください。（2017/1/1形式で入力）")
　　　　If StrPtr(期間2) = 0 Then Exit Sub
　　　　If IsDate(期間2) Then flg = True
　　Loop Until flg = True

　　'　　期間1 = CDate(期間1)
　　'　　期間2 = CDate(期間2)

’ここから
　　For Each itm In ActiveSheet.PivotTables(1).PivotFields("販売月").PivotItems
　　　　If Not IsDate(itm) Then GoTo sp
　　　　sDate = CDate(itm)
　　　　If sDate >= 期間1 And sDate <= 期間2 Then
　　　　　　itm.Visible = True
　　　　Else
　　　　　　itm.Visible = False
　　　　End If
sp:
　　Next itm

この回答へのお礼

早速の回答有難う御座います。動きました。
コードにつきましては難しく1つ1つ確認させてください。

お礼日時：2020/03/24 23:17