ピボットテーブル用の元データに年度・四半期・月フィールドを作成する

ピボットテーブルを使用すると、大量のデータを様々な角度から集計できて便利なのですが･･････、ピボットテーブルには何故か「年度」というグループ分け機能が搭載されていないため、年度ごとに集計を行う場合には非常に不便です。

例えば、集計や累計などは年単位で区切られるので1月～12月の集計・累計となり、次の1月1日からは新たな集計・累計の始まりとなります。（年度ごとの集計・累計にならない）
また、四半期ごとにグループ分けを行うと、1月が四半期の始まり（第1四半期）となるのも不便です。

これを解決する方法は、いくつかありますか、私はピボットテーブルの元データに年度・四半期・月フィールドを追加するのが一番手っ取り早いと思います（既に他の多くのサイト様でも同じように紹介されていますが･･････）

年度・四半期・月フィールドは下記のような数式で作成できます。

年度フィールド
=IF(D2="","",IF(MONTH(D2)<=3,YEAR(D2)-1&"年度",YEAR(D2)&"年度"))

四半期フィールド
=IF(D2="","",IF(MONTH(D2)<=3,"第4四半期",IF(MONTH(D2)<=6,"第1四半期",IF(MONTH(D2)<=9,"第2四半期","第3四半期"))))

月フィールド
=IF(D2="","",MONTH(D2)&"月")

※D2の部分は相対参照によって異なります

そして、ピボットテーブルを作成する際、元の「日付」フィールドは使用せずに、新たに作成した「年度」「四半期」「月」フィールドを使用しましょう。

下記のようなピボットテーブルに生まれ変わります。

4月～3月を一つの年度とし、四半期の始まりが4月になります（集計も年度単位となっています）

しかーし！

ここまでは他のサイト様が紹介している内容とさほど変わりはなく、VBAの勉強を始めてみたを謳い文句にしている当ブログの名折れとなってしまうので、年度・四半期・月フィールドを瞬時に作成するコードを作成してみました。

ピボットテーブルの元データの日付フィールドの1セルを選択した状態でマクロを実行して下さい。

日付フィールドの左側に年度・四半期・月フィールドが自動作成されます。

＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊

Sub ピボットテーブル用年度四半期月フィールド作成()
    '日付データが入ったフィールドの１セルを選択（どれでも良い）して実行
    Dim X As Long
    Dim YS As Long
    Dim YE As Long
   
    If TypeName(ActiveCell.Value) = "Date" Then
        X = ActiveCell.Column
        YS = ActiveCell.CurrentRegion.Row
        YE = ActiveCell.CurrentRegion.Rows(ActiveCell.CurrentRegion.Rows.Count).Row

        Range(Columns(ActiveCell.Column), Columns(ActiveCell.Column + 2)).Insert xlShiftToRight, _
        xlFormatFromLeftOrAbove
   
        Cells(YS, X).Value = "年度"
        Range(Cells(YS + 1, X), Cells(YE, X)).FormulaR1C1 = _
        "=IF(RC[3]="""","""",IF(MONTH(RC[3])<=3,YEAR(RC[3])-1&""年度"",YEAR(RC[3])&""年度""))"

        Cells(YS, X + 1).Value = "四半期"
        Range(Cells(YS + 1, X + 1), Cells(YE, X + 1)).FormulaR1C1 = _
        "=IF(RC[2]="""","""",IF(MONTH(RC[2])<=3,""第4四半期"",IF(MONTH(RC[2])<=6,""第1四半期"",IF(MONTH(RC[2])<=9,""第2四半期"",""第3四半期""))))"
   
        Cells(YS, X + 2).Value = "月"
        Range(Cells(YS + 1, X + 2), Cells(YE, X + 2)).FormulaR1C1 = _
        "=IF(RC[1]="""","""",MONTH(RC[1])&""月"")"
       
    Else
        MsgBox "日付データの入ったセルを選択して下さい"
       
    End If
End Sub

＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊

 ※SubからEnd Subまでをコピペしてマクロを使用できます。使用の際は自己責任でお願いいたします。