ExcelVBAとピボットテーブル：第７回　列範囲のグループ化および二段階集計

カテゴリー名：　［ExcelVBAとピボットテーブル］

当シリーズでは、Excelのピボットテーブルをプログラミングのノウハウで生成するよう試みます。

　今回は、列範囲のグループ化を取り上げます。

　また、作成したピボットテーブルを素材として別のピボットテーブルを作る例を示します。これを便宜的に「二段階集計」と呼ぶことにします。

　ソースデータとしては、第５回・第６回で用いた pt_source02.xls を利用します。

　当Webページで紹介するマクロファイルやVBScriptのファイル一式は、 vovPIVOT07.zip という圧縮ファイルに同梱しておきます。

《このページの目次》

• 1.　阻害データの概要
• 2.　列範囲のグループ化と親フィールドの作成
  • (1)　UnionによるRangeの結合
  • (2)　列範囲のグループ化による親フィールドの設定
  • (3)　親フィールドに関する調整
• 3.　列範囲のグループ化による日付の処理
  • (1)　半年単位のグループ化
  • (2)　各月を二分類
• 4.　二段階集計
  • (1)　四半期単位から半年単位を作成
  • (2)　支店ごとの利益・利益率を把握
  • (3)　加工処理を仲介させる

1.　阻害データの概要

　今回の素材データも pt_source02.xls です。

　日付、商品、売上、仕入原価の四つの列から構成されています。

　日付には、「2016/3/21」のような2016年１月１日〜12月31日の日付が入っています。

　商品には四種類あります。1) 調味料、2) 飲料、3) 乳製品、4) 魚介類。

　売上と仕入原価は、乱数発生させた値です。

　具体的には次のようなデータです。冒頭のみ掲載。

　また、pt_source02.xls には三つのワークシートがあります。

　第1ワークシートの名前が「東京支店」、第2が「名古屋支店」、第3が「大阪支店」です。

目次に戻る

2.　列範囲のグループ化と親フィールドの作成

　ソースデータの「商品」のうち、調味料と飲料を「種別Ａ」、乳製品と魚介類を「種別Ｂ」というグループにまとめることを考えます。

　その場合、ピボットテーブルにおいて親フィールドを設ける形になります。

　ここでは、その親フィールドを設定する方法を取り上げます。

(1)　UnionによるRangeの結合

　親フィールドの話題に入る前に、Rangeの結合について述べます。

　ピボットテーブルの処理に限らず、Excelのいろいろな場面で使うノウハウです。

　Rangeの結合は、Application.Union() で行います。

　次の VBAマクロを実行した場合、A1セルとB1セルが結合されます。

Sub Macro1()
    Dim rng As Range
    Set rng = Application.Union(Range("A1"), Range("B1"))
    MsgBox rng.Address
End Sub

　上を実行すると、「$A$1:$B$1」が表示されます。

　結合するのは隣接するセルでなくてもかまいません。

　Application.Union(Range("A1"), Range("H8")) とした場合は
「$A$1,$H$8」と表示されます。

　つまり、結合した結果は Range("$A$1,$H$8") と等価です。

　Unionメソッドは、最低でも二つのパラメータを必要とします。

　パラメータとして渡されたRangeオブジェクトを結合し、新たなRangeオブジェクトを返します。

　三つ以上のパラメータを渡すこともできます。すべてを結合したRangeオブジェクトを返します。

　パラメータの個数に限りがあるのかどうか分かりませんが、マイクロソフトのWebをみると、30個くらいまでは大丈夫のようです。

　プログラミングで処理する場合は、結合してできた新たなRangeオブジェクトに更にRangeを結合するという反復処理が簡単なので、Unionに渡すパラメータは、多くの場合、二つだけで用が足りるとおもいます。

目次に戻る

(2)　列範囲のグループ化による親フィールドの設定

　まず、「商品」を列フィールド、「売上」と「仕入原価」をデータフィールドにしたピボットテーブルを考えます。

　データフィールドの方向づけは、行フィールド扱い(縦方向に並べる)にします。

　ソースデータは、第１ワークシートだけ利用。

　集計表は下のようになります。

　参考まで、上の表を作成するための VBAコードを掲げておきます。ピボットフィールドを設定する部分のみです。

With ptObj.PivotFields("商品")
    .Orientation = xlColumnField
    .LabelRange.Value = "商品"
    i = 0
    For Each vObj In Array("調味料", "飲料", "乳製品", "魚介類")
        i = i + 1
        .PivotItems(vObj).Position = i
    Next
End With
With ptObj.PivotFields("売上")
    .Orientation = xlDataField
    .Function = xlSum  ' 合計を算出
    .Caption = "売上・計"
    .NumberFormat = "#,##0"
End With
With ptObj.PivotFields("仕入原価")
    .Orientation = xlDataField
    .Function = xlSum
    .Caption = "仕入原価・計"
    .NumberFormat = "#,##0"
End With
ptObj.DataPivotField.Orientation = xlRowField
ptObj.DataPivotField.Name = "合計値"

上の VBAコードに変更を加えて、調味料と飲料を「種別Ａ」、乳製品と魚介類を「種別Ｂ」というグループにまとめます。

　「商品」の列フィールドのうち、ピボットアイテムの１番と２番を結合し、３番と４番を結合します。

　結合するRangeは、ピボットアイテムの LabelRange です。

　該当箇所の VBAコードは次のとおり。

Application.Union(.PivotItems(1).LabelRange, _
    .PivotItems(2).LabelRange).Group
Application.Union(.PivotItems(3).LabelRange, _
    .PivotItems(4).LabelRange).Group

　上では、Unionから得られた Range に対して Groupメソッドを適用しています。

　このようにすると、親フィールドが設けられます。

　新設される親フィールドは一つですが、Union＆Groupを２度実行しているので、親フィールドに所属するピボットアイテムは二つできます。

　数値のグループ化と日付のグループ化のときは、行フィールドまたは列フィールドの DataRange の一つのセルに対してGroupメソッドを適用しました。

　その結果、該当フィールドに含まれるピボットアイテムの個数が減少しました。

　今回は、フィールドそのものが変化することはなく、親フィールドが新たに設けられます。

　なお、Union＆Groupを適用できるのは列フィールドに対してです。

　行フィールドに適用してもエラーは発生しませんが、必ずしも意図したグループ化にはならないようです。

　結合する Range がごく少数だと　うまくいくケースもありますが……

目次に戻る

(3)　親フィールドに関する調整

　変数 ptFld に列フィールドがセットされていて、そのフィールドを基にして親フィールドを設けた場合、ptFld.ParentField によって親フィールドのオブジェクトを取得できます。

　その親フィールドオブジェクトに所属するピボットアイテムは、
ptFld.ParentField.PivotItems(1) などとして参照します。

　今回、親フィールドにピボットアイテムが二つできますが、特に設定しない場合、その Name は、「グループ1」　「グループ2」になります(どちらも半角カタカナ)。

　これら Name を「種別Ａ」　「種別Ｂ」に変更します。

　また、種別単位の合計を表示するには Subtotalsプロパティの第１要素を True にします。

　まず、作成する集計表を示すと下のとおり。

　列フィールドの設定を行う VBAコードは下のようになります。

　その中に親フィールドの設定も含まれています。

With ptObj.PivotFields("商品")
    .Orientation = xlColumnField
    .LabelRange.Value = "商品"
    i = 0
    For Each vObj In Array("調味料", "飲料", "乳製品", "魚介類")
        i = i + 1
        .PivotItems(vObj).Position = i
    Next
    Application.Union(.PivotItems(1).LabelRange, _
        .PivotItems(2).LabelRange).Group
    Application.Union(.PivotItems(3).LabelRange, _
        .PivotItems(4).LabelRange).Group
    With .ParentField
        .PivotItems(1).Name = "種別Ａ"
        .PivotItems(2).Name = "種別Ｂ"
        .Subtotals(1) = True
    End With
End With

　なお、集計表の中から調味料、飲料、乳製品、魚介類という商品の元々の名前を消して、種別Ａ、種別Ｂという親フィールドだけを表示させる場合は、親フィールドの設定が済んでから、列フィールドを非表示にします。

　VBAコードは次のとおり。

With ptObj.PivotFields("商品")
    .Orientation = xlColumnField
    （中略）
    With .ParentField
        .PivotItems(1).Name = "種別Ａ"
        .PivotItems(2).Name = "種別Ｂ"
    End With
    .Orientation = xlHidden
End With

　下のような集計表になります。

　「商品」のグループ化に関するマクロとスクリプトを別のWebに掲載しておきます。

列範囲のグループ化・基本形

目次に戻る

3.　列範囲のグループ化による日付の処理

　いわゆる日付のグループ化には半年単位がありません。

　また、各月を1日〜15日と、16日から月末日までに二分して示すといったことも簡単には行えません。

　そうした集計には 列範囲のグループ化が必要です。

　やり方は、前述の「商品」に対する「種別Ａ」　「種別Ｂ」のグループ化と同じですが、ピボットアイテムの個数が 366 と多いので、Unionを使わずに行います。

(1)　半年単位のグループ化

　日付データは、Set ptFld = ptObj.PivotFields("日付") としてピボットフィールドオブジェクトを取り出しただけで、実は「日」単位で取りまとめられています。

　ソースデータには同じ日付のものが四個ずつあるので、366×４行だけのデータがありますが、ptFld.PivotItems.Count でピボットアイテムの個数をみると 366 です。

　順番は、１月１日 → 12月31日の昇順になっています。

　「日」単位での日付のグループ化を適用しなくても、そうなります。

　ピボットアイテムの Name をみると、「1/1/2016」とか「6/30/2016」のように、月・日・年の順になっています。

　そのことを利用して、グループの始点と終点を把握し、グループ化の処理を行います。

　Range() にはセル範囲を結合する機能があります。

　以下の三つの記述は、いずれも同じ Rangeオブジェクトを返します。

Range("A1:D1")
Range("A1", "D1")
Range(Range("A1"), Range("D1"))

　上記は、三つともセル四個からなる Range を返します。

　こうしたことから、一年の上半期と下半期のグループ化は、VBAコードで下のように書くことができます。

Range(.PivotItems("1/1/2016").LabelRange, _
    .PivotItems("6/30/2016").LabelRange).Group
Range(.PivotItems("7/1/2016").LabelRange, _
    .PivotItems("12/31/2016").LabelRange).Group

　上のようにすれば、二つのピボットアイテムを持つ親フィールドが作られます。

　第１アイテムが上半期、第２が下半期です。

　今回のソースデータには、区切りとなる日付のデータがそろっているので上記のように書いてもいいのですが、実践での応用を考えるとそう簡単ではありません。

　定休日の関係で 7月1日という日付がソースデータに存在しなければ、上記の VBAコードが動作しません。

　ということで、やはりピボットアイテムを一つずつチェックするのが無難なようです。

　プログラミングでその辺りをどう記述するかは好みの問題ですが、一つの参考として掲げてみます。

　プログラムの要点は次のとおり。

• 二つの配列 addrAry, nameAry を用意。
  addrAryには "A1:D1" のようなRangeのアドレスを記録。
  nameAryには "2016上半期" のような名前を記録。
• ピボットアイテム一つずつをチェック。
  アイテムのNameから月数 monthVal を把握。
  monthValが7未満なら、変数 nameNow に "2016上半期" を代入。
  7以上になると nameNow に "2016下半期" を代入。
• nameNow の他に、従来の「期」を記録しておく nameOld を設けておき、
  nameNow と nameOld が一致しなくなったら、addrAry, nameAry を更新。
• 第１のピボットアイテムと最後のアイテムは例外処理。

　配列 addrAry, nameAry は、添え字を気にせずに使える ArrayListオブジェクトを利用します。

　以下、VBAコードの列フィールド設定部分です。

　ソースデータが複数年にわたっている場合にも適用できるよう考えたつもりです。

Set addrAry = CreateObject("System.Collections.ArrayList")
Set nameAry = CreateObject("System.Collections.ArrayList")
With ptObj.PivotFields("日付")
    .Orientation = xlColumnField
    .LabelRange.Value = "期間区分"
    For i = 1 To .PivotItems.Count
        Set itmRng = .PivotItems(i).LabelRange
        vAry = Split(.PivotItems(i).Name, "/")
        monthVal = CInt(vAry(0))
        If monthVal < 7 Then nameNow = vAry(2) & "上半期" _
        Else nameNow = vAry(2) & "下半期"
        If i = 1 Then
            addrAry.Add(itmRng.Address)  ' 始点を記録
            nameAry.Add(nameNow)
            nameOld = nameNow
        ElseIf nameNow <> nameOld Then
            addrAry(addrAry.Count-1) = addrAry(addrAry.Count-1) & _
                ":" & .PivotItems(i-1).LabelRange.Address  ' 終点を記録
            addrAry.Add(itmRng.Address)  ' 始点を記録
            nameAry.Add(nameNow)
            nameOld = nameNow
        End If
        If i = .PivotItems.Count Then
            addrAry(addrAry.Count-1) = addrAry(addrAry.Count-1) & _
                ":" & itmRng.Address  ' 終点を記録
        End If
    Next
    If addrAry.Count > 1 Then
        For i = 0 To addrAry.Count-1
            Range(addrAry(i)).Group
        Next
        For i = 0 To nameAry.Count-1
            .ParentField.PivotItems(i+1).Name = nameAry(i)
        Next
        .Orientation = xlHidden
    End If
End With

目次に戻る

(2)　各月を二分類

　各月を1日〜15日と、16日から月末日までに二分し、12ヶ月分を示すよう試みます。

　今度は月数(monthVal)でなく、月の中の日数(dayVal)に着目し、
dayVal が 16 未満かどうかでグループの区切りを判断します。

　これは、前述の半年単位のコードを少し書き換えれば実現できますが、それだとつまらないので、今度は hash を使ってみます。

　通常の配列の添え字は整数値ですが、hashの添え字は文字列です。

　addrHash("1月上期") = "B1:P1" というような記述ができます。

　あと、24個のグループを列として横方向に並べるのでなく、最終的に縦方向に切り替えます。

　グループ化の処理を施すのは列フィールドでなければなりませんが、グループ化の処理終了後、新設される親フィールドを行フィールドに変更するのは差し支えありません。

　該当のフィールド設定部分(VBAコード)は下のとおり。

Set addrHash = CreateObject("Scripting.Dictionary")
With ptObj.PivotFields("日付")
    .Orientation = xlColumnField
    For i = 1 To .PivotItems.Count
        Set itmRng = .PivotItems(i).LabelRange
        vAry = Split(.PivotItems(i).Name, "/")
        dayVal = CInt(vAry(1))
        If dayVal < 16 Then nameNow = vAry(0) & "月上期" _
        Else nameNow = vAry(0) & "月下期"
        If i = 1 Then
            addrHash.Add nameNow, itmRng.Address  ' 始点を記録
            nameOld = nameNow
        ElseIf nameNow <> nameOld Then
            addrHash(nameOld) = addrHash(nameOld) & _
                ":" & .PivotItems(i-1).LabelRange.Address  ' 終点を記録
            addrHash.Add nameNow, itmRng.Address  ' 始点を記録
            nameOld = nameNow
        End If
        If i = .PivotItems.Count Then
            addrHash(nameNow) = addrHash(nameNow) & _
                ":" & itmRng.Address  ' 終点を記録
        End If
    Next
    keys = addrHash.keys
    If UBound(keys) > 1 Then
        For i = LBound(keys) To UBound(keys)
            Range(addrHash(keys(i))).Group
        Next
        For i = LBound(keys) To UBound(keys)
            .ParentField.PivotItems(i+1).Name = keys(i)
        Next
        .ParentField.Orientation = xlRowField
        .ParentField.LabelRange.Value = "期間区分"
        .Orientation = xlHidden
    End If
End With

　列範囲のグループ化による日付の処理に関連して、マクロとスクリプトを別のWebに掲載しておきます。

列範囲のグループ化による日付の処理

目次に戻る

4.　二段階集計

　一度のピボットテーブル作成で意図した集計を行えない場合、
まずソースデータを作成し(ピボットテーブルとして作成)、
それを基にして更にピボットテーブルを作成します。

(1)　四半期単位から半年単位を作成

　日付のグループ化には半年単位のグループ化が用意されていません。

　であれば、まず四半期単位のグループ化を行い、第1四半期と第2四半期、第3四半期と第4四半期をUnion＆Groupでグループ化すればいいのではないか、という発想が浮かびます。

　ただ、残念ながら単純な形ではこの発想を実現できません。

　四半期単位のグループ化を施したフィールドに対して、Union＆Groupを実行しても親フィールドが生成されないようです。

　エラーは起きませんが、親フィールドが作られないようです。

　そこで、まず四半期単位のグループ化を施したピボットテーブルを作成し、
次に、そのピボットテーブルをソースデータとして半年単位のピボットテーブルを作ります。

　面倒ではありますが、こうした二段階方式を採れば、先の発想が実現できます。

　第一段階で作る表は次のとおり。

　この表をあえて第２ワークシートに作ります。

　表を作るには次のステップで行います。

• 「日付」を行フィールドにし、その上で四半期単位でグループ化。
• 「売上」と「仕入原価」をデータフィールドに設定。Functionは xlSumの合計。
• デフォルトだと「総計」が表示されてしまうので、非表示に設定。

　参考まで、この第一段階の表を作るための VBAコードを掲げておきます(抜粋)。

　配列の添え字は、1 でなく 0 から始めるようにしました。

Set ws = WorkSheets(2)  ' 第２シートにソースピボットを作成
（中略）
For i = 0 To 6
    argAry(i) = False
Next
argAry(5) = True  ' 6番目の要素をtrueに。四半期単位の指定
With ptObj.PivotFields("日付")
    .Orientation = xlRowField
    .LabelRange.Value = "日付2"
    .DataRange.Cells(1).Group Periods:=argAry
End With
With ptObj.PivotFields("売上")
    .Orientation = xlDataField
    .Function = xlSum  ' 合計を算出
    .Caption = "売上2"
End With
With ptObj.PivotFields("仕入原価")
    .Orientation = xlDataField
    .Function = xlSum
    .Caption = "仕入原価2"
End With
ptObj.ColumnGrand = False  ' 総計を非表示

　第一段階の表の領域は、ptObj.TableRange1 で得ることができます。

　ただ、この領域の第１行目には、「売上2」の真上に「値」というのがぽつんとあります。

　ソースデータとして使うときは、この「値」がある第１行目を対象外にします。

Set rng = ptObj.TableRange1
Set rng = rng.Offset(1).Resize(rng.Rows.Count-1)

　上のようにすれば、変数 rng が第２段階のソースデータとして使えるRangeになります。

　あとは、第二段階のピボットキャッシュとピボットテーブルを新設するところから始めて、列範囲のグループ化を行えば目的の集計表を得ることができます。

　目的の表は、第１ワークシートに設けます。

　集計表を示した後で、該当の VBAコードを掲げます。

　以下、第二段階のピボットテーブルを設定する VBAコードです。

Set rng = ptObj.TableRange1  ' 第１ピボットの領域
Set rng = rng.Offset(1).Resize(rng.Rows.Count-1)  ' 1行目を対象外
rngName = ws.Name & "!" & rng.Address
　　　　
Set ws = WorkSheets(1)
ws.Activate  ' 第１シートをアクティブに
Set ptCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
    SourceData:=rngName)
Set ptObj = ptCache.CreatePivotTable( _
    TableDestination:="R1C1", TableName:="ピボット01")
With ptObj.PivotFields("日付2")
    .Orientation = xlColumnField
    .LabelRange.Value = "期間区分"
    Application.Union(.PivotItems(1).LabelRange, _
        .PivotItems(2).LabelRange).Group
    Application.Union(.PivotItems(3).LabelRange, _
        .PivotItems(4).LabelRange).Group
    With .ParentField
        .PivotItems(1).Name = "上半期"
        .PivotItems(2).Name = "下半期"
        .Subtotals(1) = True
    End With
End With
With ptObj.PivotFields("売上2")
    .Orientation = xlDataField
    .Function = xlSum  ' 合計を算出
    .Caption = "売上・計"
    .NumberFormat = "#,##0"
End With
With ptObj.PivotFields("仕入原価2")
    .Orientation = xlDataField
    .Function = xlSum
    .Caption = "仕入原価・計"
    .NumberFormat = "#,##0"
End With
ptObj.DataPivotField.Orientation = xlRowField
ptObj.DataPivotField.Name = "合計値"

目次に戻る

(2)　支店ごとの利益・利益率を把握

　今度は列範囲のグループ化から離れます。

　ソースデータには三つのワークシートがあります。支店別のデータになっています。

　三つのワークシートを一括して扱い、支店それぞれの売上と仕入原価を示すことは、「第６回」でみたように xlConsolidation の指定で可能です。

　でも、それに利益と利益率を加えることができるかというと、xlConsolidation を使う場合、難しいのではないかとおもいます。

　ということで、二段階集計を試みます。

　まず、第１の集計表は次のようにします。

　上の表を作るための VBAコードは下のとおり(フィールド設定部分のみ)。

　行・列の順番や体裁を気にしなくていいので短くて済みます。

ptObj.RowFields(1).Orientation = xlHidden  ' 日付を非表示に
ptObj.ColumnFields(1).PivotItems("商品").Visible = False
ptObj.DataFields(1).Function = xlSum
With ptObj.PageFields(1)
    .Orientation = xlRowField
    .LabelRange.Value = "支店"
End With
ptObj.RowGrand = False
ptObj.ColumnGrand = False

　最後の２行は、行・列の「総計」を非表示にするための記述です。

　最終的な集計表は次のようになります。

　第２のピボットテーブル作成の VBAコードは、「第６回」と今回「第７回」の説明で出てきたコードを僅かに書き換えて組み立てただけなので、ここでは省略します(別Webに掲載)。

　二段階集計について注意していただきたいのは、ピボットテーブルを更新する際、第１のピボットテーブルの Refresh を忘れてはいけない点です。そちらが先決です。

　作ったピボットテーブルを他の人に提供するような場合は、自動更新処理の仕組みを組み込む必要があるかもしれません。

　二段階集計にはそうした難点がありますが、ワンステップの処理にこだわるよりも、二段階にすることで処理が逆にスムーズになることがあります。

　二段階集計に関連するマクロとスクリプトを別のWebに掲載しておきます。

二段階集計

目次に戻る

(3)　加工処理を仲介させる

　これまでの例だと、「わざわざ二段階集計したのに、最終的に得られる集計表がどうも しょぼい」と感じた方がおおいのではないかとおもいます。

　実のところ、私自身がそう感じます。なんか消化不良。

　ということで、ピボットテーブルのrefreshのやりやすさを損なうことになりますが、加工処理を加えたプログラムを作ってみました。

　第１ピボットテーブルの表をそのままソースデータにするのでなく、
Excelの一般的なセル操作により修正を施して、
それを第２ピボットのソースデータとして利用します。

　支店別×四半期別のクロス集計で、
中身の数値は、売上、仕入原価、利益、利益率の四つ
そうした表を最終的に作ります。

　ピボットテーブルの処理という意味では新しい事柄がないので、プログラムをここにはかかげません。

　zip圧縮ファイルに入っている macro06.txt, pt06.vbs, pt06.js が該当のプログラムなのでそちらを参照してください。

　各段階の表だけ示します。

　まず、第１ピボットテーブルとして作られる表は下のとおり。

　「日付」が行フィールドになっているところに、
ページフィールド(支店)も行フィールドに指定すると下の表になります。

　上記の表に対して Excelの一般的なセル操作を施して次の表にします。

　この表をソースデータにすれば、「支店別×四半期別」のクロス集計を行うのは用意です。

　最終的な集計表は、横にかなり長い表なので省略します。

　第１ピボットテーブルの表を加工する際、「売上」と「仕入原価」の列に空白セルがあることを手掛かりにします。

　空白セルかどうかを判別するのに、VBA, VBScript では下のように書きます。

If rng.Cells(i,2).Value = "" Then ……

　一方、JScript では同じように書いてもダメなので、次のようにします。

if (typeof(rng.Cells(i,2).Value) === "undefined") { ……

　ちょっと引っかかったので記しました。

〜　以上　〜