Worksheet_PivotTableUpdateイベントでスライサー変更時に値をセルにセット

質問内容と結果の操作を先に見せる

質問: Excelのピボットテーブルでタイムラインを使用してフィルターをかけています。タイムラインで選択した期間を別セルに表示することは可能でしょうか？可能であれば方法を教えてください。

回答: シートにマクロを記載できるなら可能です。B1に開始 StartDate、B2に終了 EndDate をセットするマクロを解説します。

https://www.youtube.com/live/GTgvCh9GJg4

www.youtube.com

テスト環境の準備

明細データからピボットテーブルとタイムラインを作成します。

聞きなれないタイムラインのスライサーは、ピボットテーブル作成後、日付の部分をクリックして、メニューに表示された[ピボットテーブル分析]から[タイムラインの挿入]を選択することで作成できます。

VBAコードの解説

スライサーの変更のタイミングを取得する方法

シートのイベントに PivotTableUpdate という面白そうなイベントがあるので、ここからテストを開始します。

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
    Debug.Print "Worksheet_PivotTableUpdate", Now()
    Debug.Print Target.Name
End Sub

スライサーまでたどり着く方法

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
    Debug.Print "Worksheet_PivotTableUpdate", Now()
    Debug.Print Target.Name
    Debug.Print "スライサーの数:", Target.Slicers.Count
    
    Dim n As Long
    For n = 1 To Target.Slicers.Count 'スライサーが複数立ち上がっているかも？
        Debug.Print "-", "名前:", Target.Slicers(n).Caption
        If Target.Slicers(n).Caption = "日付" Then  '名前で判断してみた
        End If
    Next
End Sub

スライサーの中身を表示する

過去動画を参考にコードをコピーします。

Sub test002_在庫0とアリ全てを切り替える()

    'スライサーをSlicerCachesから名前指定でセット
    Dim oSlicer As Excel.SlicerCache
    Set oSlicer = ActiveWorkbook.SlicerCaches("スライサー_在庫数")

    '在庫0のOn/Offを保存
    Dim bFLG As Boolean   'True/False
    On Error Resume Next
    bFLG = oSlicer.SlicerItems("0").Selected  '現在の状態を保存
    If Err.Number <> 0 Then  '↑でエラーかチェック
        MsgBox "在庫0がありません", vbExclamation
        Exit Sub
    End If
    On Error GoTo 0
    
    'ループで全てのチェックを付ける、外す
    Dim n As Long
    For n = 1 To oSlicer.SlicerItems.Count
        If oSlicer.SlicerItems(n).Value = "0" Then '在庫"0"か、それ以外か判断
            oSlicer.SlicerItems(n).Selected = Not bFLG '反対をセット
        Else  'その他の在庫数 状態を変える
            oSlicer.SlicerItems(n).Selected = bFLG '保存状態をセット※↑上と違う
        End If
    Next

End Sub

今回は日付のスライサーなので、TimelineState の値を見ます。

FilterValue1,2 と StartDate,EndDate どちらも同じ値です。[cite: 4]

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
    Debug.Print "Worksheet_PivotTableUpdate", Now()
    Debug.Print Target.Name
    Debug.Print "スライサーの数:", Target.Slicers.Count
    
    Dim n As Long
    For n = 1 To Target.Slicers.Count
        Debug.Print "-", "名前:", Target.Slicers(n).Caption
        If Target.Slicers(n).Caption = "日付" Then
            'ここから、中身を探る キャッシュの下が気になるけど
            Dim oSlicer As Excel.SlicerCache
            Set oSlicer = Target.Slicers(n).SlicerCache  '=Caption = "日付"のスライサーを代入
            '日付の範囲なので
            Debug.Print "|", "TimelineState.StartDate=", oSlicer.TimelineState.StartDate
            Debug.Print "|", "TimelineState.EndDate=", oSlicer.TimelineState.EndDate
            Debug.Print "|", "TimelineState.FilterValue1=", oSlicer.TimelineState.FilterValue1
            Debug.Print "|", "TimelineState.FilterValue2=", oSlicer.TimelineState.FilterValue2
        End If
    Next
End Sub

エラー発生の操作を説明する

セルに値をセットする前に注意事項があります。スライサーの操作ではなく、日付を押して自分でフィルターをかけると、当然中身の集計更新が走ります。するとエラーになるので注意が必要です。

On Error Resume Next と On Error GoTo 0 が必要です。

テストでB1に開始日、B2に終了日をセットする

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
    Debug.Print "Worksheet_PivotTableUpdate", Now()
    Debug.Print Target.Name
    Debug.Print "スライサーの数:", Target.Slicers.Count
    
    Dim n As Long
    For n = 1 To Target.Slicers.Count
        Debug.Print "-", "名前:", Target.Slicers(n).Caption
        If Target.Slicers(n).Caption = "日付" Then
            'ここから、中身を探る キャッシュの下が気になるけど
            Dim oSlicer As Excel.SlicerCache
            Set oSlicer = Target.Slicers(n).SlicerCache  '=Caption = "日付"のスライサーを代入
            '日付をセットする
            'エラーをチェックして、エラー無しならセットする
            On Error Resume Next
            Debug.Print "|", "TimelineState.StartDate=", oSlicer.TimelineState.StartDate
            Debug.Print "|", "TimelineState.EndDate=", oSlicer.TimelineState.EndDate
            If Err.Number = 0 Then  '↑でエラーかチェック 正常=0
                Range("B1") = oSlicer.TimelineState.StartDate
                Range("B2") = oSlicer.TimelineState.EndDate
            Else
                'エラーの時、"スライサーで選択されていません"をセット
                Range("B1") = "スライサーで選択されていません"
                Range("B2") = "スライサーで選択されていません"
            End If
            On Error GoTo 0
        End If
    Next
End Sub

終了前に再度設置方法を説明する

回答下書き

回答: マクロの設置が可能なら、シートに Worksheet_PivotTableUpdate のマクロを記載すると、スライサー変更のタイミングで値をセルにセットできそうです。

例: B1に開始 StartDate、B2に終了 EndDate をセットするマクロです。

下記のコードを使うと、上記動画みたいなことができます。

※やりたい事・質問内容と動画内の処理が合っているか、2倍速で5分くらい見て判断してください。

マクロをコピーします。

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
    Debug.Print "Worksheet_PivotTableUpdate", Now()
    Debug.Print Target.Name
    Debug.Print "スライサーの数:", Target.Slicers.Count
    
    Dim n As Long
    For n = 1 To Target.Slicers.Count
        Debug.Print "-", "名前:", Target.Slicers(n).Caption
        If Target.Slicers(n).Caption = "日付" Then
            'ここから、中身を探る キャッシュの下が気になるけど
            Dim oSlicer As Excel.SlicerCache
            Set oSlicer = Target.Slicers(n).SlicerCache  '=Caption = "日付"のスライサーを代入
            '日付をセットする
            'エラーをチェックして、エラー無しならセットする
            On Error Resume Next
            Debug.Print "|", "TimelineState.StartDate=", oSlicer.TimelineState.StartDate
            Debug.Print "|", "TimelineState.EndDate=", oSlicer.TimelineState.EndDate
            If Err.Number = 0 Then  '↑でエラーかチェック 正常=0
                Range("B1") = oSlicer.TimelineState.StartDate
                Range("B2") = oSlicer.TimelineState.EndDate
            Else
                'エラーの時、"スライサーで選択されていません"をセット
                Range("B1") = "スライサーで選択されていません"
                Range("B2") = "スライサーで選択されていません"
            End If
            On Error GoTo 0
        End If
    Next
End Sub

シート名で右クリックし、[コードの表示]からVBAマクロコードを貼り付けます。
B1, B2のセット位置を自分の環境に合わせます。
日付とスライサー名が付いてますが、販売日など違う名前なので、ここも自分の環境に合わせて名前を変更します。
テストします。
今後の課題

特定のシートのマクロを記載するのは悪手です。

※マクロ付きのブックで保存しないといけない

※※マクロを変更した時に、過去のブックのマクロ修正が必要な、マクロのバージョン違いなど

アドインにするとか、何か考えないと汎用性が無いでしょう。

以上、ピボットテーブルのスライサーに反応するマクロの紹介でした。

解決のヒントとなれば幸いです。

VBAのコード説明は頭から右往左往しながらやってます。

三流君のソースコード置き場

ブログにソースコードをアップして、ブログの検索機能で利用してます(利用予定です)