ExcelVBAとピボットテーブル：第４回　数値のグループ化

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

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

　今回は、身長のような数値のグループ化を取り上げます。

　「150〜160」　「160〜170」といった範囲に何人属するかを数え上げます。

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

《このページの目次》

• 1.　グループ化の前の未加工の集計表
  • (1)　単純に身長の値を横方向に並べる
  • (2)　空白セルと個数の数え上げ
• 2.　グループ化の基本形
  • (1)　ピボットフィールドが占める領域を表すDataRange
  • (2)　Groupメソッド
  • (3)　VBAマクロ
  • (4)　VBScript
  • (5)　JScript
• 3.　グループ化した集計表の修正と拡張
  • (1)　ピボットアイテムの順序の入れ替えと名前変更
  • (2)　パーセンテージの追加
  • (3)　性別を加味したクロス集計

1.　グループ化の前の未加工の集計表

　グループ化することを加工処理であるとすれば、まず、それを行う前の未加工の集計をやってみます。

(1)　単純に身長の値を横方向に並べる

　身長の値を数値ではなく単なる名前だと考えて、それを列フィールドにすれば、身長の値が横方向にずらずら並ぶ形になります。

　人数をカウントする手がかりとしてＩＤを用いる場合、ピボットフィールドを定義するVBAのコードは次のようになります。

With ptObj.PivotFields("身長")
    .Orientation = xlColumnField
.LabelRange.Value = .Name
End With
With ptObj.PivotFields("ＩＤ")
    .Orientation = xlDataField
    .Function = xlCount
    .Caption = "人数"
End With

　結果として作られる集計表は下のとおり。

　途中を省略しましたが、横方向に長く広がる表です。

　148.3の人が２人いますが、多くは該当人数が１人です。

　身長の記載のない人が８人、合計で400人であることも分かります。

目次に戻る

(2)　空白セルと個数の数え上げ

　グループ化の前に、注意点を一つ。空白セルについてです。

　今回のソースデータでは、ＩＤの列には空白セルがありません。

　一方、性別、身長、体重の列には少数ながら空白セルがあります。

　身長の該当人数を数え上げるのに、わざわざＩＤを使わなくても、身長を使えばいいのではないかという発想は自然だとおもいます。

　VBAのコードで書けば、下のようにする訳です。

With ptObj.PivotFields("身長")
    .Orientation = xlColumnField
.LabelRange.Value = .Name
End With
With ptObj.PivotFields("身長")
    .Orientation = xlDataField
    .Function = xlCount
    .Caption = "人数"
End With

　しかし、上のコードでは期待する結果が得られません。

　次のような集計表になってしまいます。

　「(空白)」が8でなく空欄になり、「総計」が400でなく392になってしまいます。

　つまり、表を見ただけでは身長の記載がない人の人数が分かりません。

　ソースデータ中の空白セルが「存在しないもの」として扱われ、数え上げの対象から除外されてしまうためそうなります。

　平均値等の算出のときは、「存在しないもの」として扱われる方がいいですが、
xlCount の数え上げの場合は、空白セルは空白セルとして数えてくれると便利です。
でも、そういう訳にはいかないようです。

　ソースデータ中の空白セルの扱いを切り替えるためのオプションがないか調べてみましたが、分かりませんでした。

　今回は、ＩＤの列に空白セルがないのでそれを利用しましたが、
そういう列がない場合は、わざわざでも便宜的に設けておくのがいいのでは？
と感じます。空白セルのない列を設けておく訳です。

　もちろん、記載のないものを対象外として、総計392人に絞って集計したいこともあるとおもいます。

　その場合は、ＩＤでなく身長を数え上げの手がかりにすればいい訳です。

目次に戻る

2.　グループ化の基本形

　本論のグループ化について述べます。

(1)　ピボットフィールドが占める領域を表すDataRange

　前述のVBAコードでは、身長を列フィールドにし、ＩＤをデータフィールドにしました。

　グループ化したいのは当然ながら列フィールドの身長です。

　この列フィールドが占める領域は DataRange にセットされています。

　この DataRange を見ると、フィールドが占める領域を確認できます。

　たとえば下のVBAコードを実行したとします。

With ptObj.PivotFields("身長")
    .Orientation = xlColumnField
    .LabelRange.Value = .Name
    MsgBox .DataRange.Address(ReferenceStyle:=xlR1C1)
End With

　そうすると、メッセージボックスに R2C1:R2C204 と表示されます。

　これが列フィールドの占める領域です。

　行としては第２行目の１行だけですが、
列の方は、第１列目から第204列目までを占めています。

　この DataRange には「総計」が含まれません。右端は「(空白)」です。

　グループ化を行うための Groupメソッドは、この DataRange に対して適用します。

　ここで少しややこしい話を一つ。

　DataRange は、ＩＤをデータフィールドとして設定する前なら R2C1:R2C204 の領域ですが、ＩＤのフィールドを設定した後だと、右に一つだけずれて R2C2:R2C205 となります。

　ＩＤのデータフィールドには「人数」というラベル名があります。それが挿入されることに応じて一つずれる訳です。

　単純にグループ化する場合は、この「ずれ」を気にする必要はありません。

　ＩＤを設定する前にグループ化しても、設定後にグループ化しても、同じ集計表になります。

　ただ、ＩＤにより検出される人数との組み合わせを加味して調整するようなときは、ＩＤのフィールド設定後にグループ化の処理を施すのがいいということになります。

目次に戻る

(2)　Groupメソッド

　グループ化を行うための Groupメソッドは、DataRange に対して適用しますが、DataRange全体ではなく、その領域の中の一つのセルに対して適用します。

　DataRange.Cells(1,1) とすれば Rangeの左上端のセルを得ることができます。

　DataRange.Cells(1) と書いても同じ意味になります。

　通常、こうして得た左上端のセルに Groupメソッドを適用します。

　今回のケースに即して書くと、グループ化は、次のような VBAコードになります。

.DataRange.Cells(1).Group Start:=140.0, By:=10.0

　上は、スタートの値(下限値)を 140.0 にし、区分幅を 10.0 にするという意味です。

　このコードから下の表ができます。

　上記の「150-160」は、150以上・160未満の意味です。160ちょうどは、この区分に入りません。

　Groupメソッドのパラメータは次のとおり。

• Start　グループ化する際の下限値
  　省略すると、該当Rangeの最小値が採用される。
• End　グループ化する際の上限値
  　省略すると、該当Rangeの最大値が採用される。
• By　各グループのサイズ(区分幅)
• Periods　日付のグループ化に使用(配列)：別の機会に触れます。

　先のコードでは上限値を省略していますが、適当に設定してくれています。

目次に戻る

(3)　VBAマクロ

　これまで部分的な VBAコードを示してきただけなので、この辺でマクロ全体を掲げます。

　表として修正したい点はありますが、とりあえずグループ化の基本形として掲げます。

 Sub Macro1()
     Dim pName As String, bName As String
     Dim ptCache As PivotCache, ptObj As PivotTable
 　　　　
     pName = ThisWorkbook.Path  ' 本ワークブックのフォルダ名
     bName = ThisWorkbook.Name  ' 本ワークブックの名前
     Workbooks.Open pName & "\pt_source.xls"  ' ソースデータを開く
     Workbooks(bName).Activate  ' 本ワークブックをアクティブに
     WorkSheets(1).Activate  ' 第１シートをアクティブに
　　　　
    Set ptCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
        SourceData:="[pt_source.xls]Sheet1!SourceDataRange")
    Set ptObj = ptCache.CreatePivotTable( _
        TableDestination:="R1C1", TableName:="ピボット01")
　　　　
    With ptObj.PivotFields("身長")
        .Orientation = xlColumnField
        .LabelRange.Value = .Name
        .DataRange.Cells(1).Group Start:=140.0, By:=10.0
    End With
    With ptObj.PivotFields("ＩＤ")
        .Orientation = xlDataField
        .Function = xlCount
        .Caption = "人数"
    End With
End Sub

目次に戻る

(4)　VBScript

　先の VBAマクロと同じ働きをする VBScript を掲げます。

　Book1.xlsx を作成します。開くとピボットテーブルが作られているはずです。

 Option Explicit
 Dim fso, bookPath, srcPath
 Dim exlApp, wbObj
 Dim ptCache, ptObj
 Include "constants_xl.vbs"
 　　　　
 Set fso = CreateObject("Scripting.FileSystemObject")
 bookPath = fso.GetAbsolutePathName("Book1.xlsx")
 If (fso.FileExists(bookPath) = True) Then fso.DeleteFile(bookPath)
srcPath = fso.GetAbsolutePathName("pt_source.xls")
Set exlApp = CreateObject("Excel.Application")  ' Excelの起動
exlApp.Visible = True  ' Excelを見える状態に
exlApp.Workbooks.Open srcPath
Set wbObj = exlApp.Workbooks.Add()  ' Workbookの新規作成
wbObj.WorkSheets(1).Activate
Set ptCache = wbObj.PivotCaches.Create(xlDatabase, _
    "[pt_source.xls]Sheet1!SourceDataRange")
Set ptObj = ptCache.CreatePivotTable( _
    "R1C1", "ピボット01")
　　　　
With ptObj.PivotFields("身長")
    .Orientation = xlColumnField
    .LabelRange.Value = .Name
    .DataRange.Cells(1).Group 140.0,, 10.0
End With
With ptObj.PivotFields("ＩＤ")
    .Orientation = xlDataField
    .Function = xlCount
    .Caption = "人数"
End With
wbObj.SaveAs bookPath, xlOpenXMLWorkbook
exlApp.quit

目次に戻る

(5)　JScript

　先の VBScript と同じ処理をする JScript を掲げます。

 var fso, bookPath, srcPath;
 var exlApp, wb;
 var ptCache, ptObj;
 eval(ReadFile("constants_xl.js"));
 　　　　
 fso = WScript.CreateObject("Scripting.FileSystemObject");
 bookPath = fso.GetAbsolutePathName("Book1.xlsx");
 if (fso.FileExists(bookPath))  fso.DeleteFile(bookPath);
 srcPath = fso.GetAbsolutePathName("pt_source.xls");
exlApp = WScript.CreateObject("Excel.Application");  // Excelの起動
exlApp.Visible = true;  // Excelを見える状態に
exlApp.Workbooks.Open(srcPath);
wb = exlApp.Workbooks.Add();  // Workbookの新規作成
wb.WorkSheets(1).Activate();
　　　　
ptCache = wb.PivotCaches().Create(xlDatabase,
    "[pt_source.xls]Sheet1!SourceDataRange");
ptObj = ptCache.CreatePivotTable(
    "R1C1", "ピボット01");
　　　　
with (ptObj.PivotFields("身長")) {
    Orientation = xlColumnField;
    LabelRange.Value = Name;
    DataRange.Cells(1).Group(140.0, null, 10.0);
}
with (ptObj.PivotFields("ＩＤ")) {
    Orientation = xlDataField;
    Function = xlCount;
    Caption = "人数";
}
wb.SaveAs(bookPath, xlOpenXMLWorkbook);
exlApp.Quit();

目次に戻る

3.　グループ化した集計表の修正と拡張

　集計表の項目(ピボットアイテム)の順序の入れ替えと名前変更、
人数に加えてパーセンテージも表示する方法、
性別(男女別)を加味したクロス集計表の作成を取り上げます。

(1)　ピボットアイテムの順序の入れ替えと名前変更

　前述の VBAマクロでグループ化した結果、「<140 または (空白)」という項目が現れました。

　ソースデータには 140未満の人がいないので、ここは要するに「身長の記載のない人」を意味します。

　この名前を「記載無し」に変更することにします。

　また、一番 左に「記載なし」がくるよりも「総計」の左隣にくる方が自然な感じがするので、順番も入れ替えます。

　文章にするとこれだけのことですが、VBAのコードとして書くと少し長くなります。

　ピボットアイテム全部の Position プロパティの値を変更する必要があるので、Forループを使います。

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

With ptObj.PivotFields("身長")
    .Orientation = xlColumnField
    .LabelRange.Value = .Name
    .DataRange.Cells(1).Group Start:=140.0, By:=10.0
    iName = .PivotItems(1).Name  ' 第1アイテムの名前
    For i = 2 To .PivotItems.Count  ' 第2以降の順序を繰り上げ
        .PivotItems(i).Position = i - 1
    Next
    .PivotItems(iName).Position = .PivotItems.Count  ' 第1だったのを最後に
    .PivotItems(iName).Name = "記載なし"
End With

　PivotItems.Count は、ピボットフィールド中に何個のピボットアイテムがあるかを示します。

　第１アイテムの名前を取得し、
第２アイテム以降の順序を一つ筒繰り上げ、
第１アイテムだったものを最後に配置するというのが上記のコードです。

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

　VBScript の該当箇所の記述は VBAのコードと同じです。

　JScript だと少し違うので下に掲載しておきます。

with (ptObj.PivotFields("身長")) {
    Orientation = xlColumnField;
    LabelRange.Value = Name;
    DataRange.Cells(1).Group(140.0, null, 10.0);
    iName = PivotItems(1).Name;  // 第1アイテムの名前
    for(i = 2; i <= PivotItems.Count; i++) {  // 第2以降の順序を繰り上げ
        PivotItems(i).Position = i - 1;
    }
    PivotItems(iName).Position = PivotItems.Count;  // 第1だったのを最後に
    PivotItems(iName).Name = "記載なし";
}

　VBAマクロ、VBScript、JScript が zip圧縮ファイルに含まれているので参考にして下さい。

目次に戻る

(2)　パーセンテージの追加

　これまで、身長の各区分について人数を表示してきました。

　実践的には、人数の他にパーセンテージもほしいところです。

　次のような表です。

　上の表を作るにはデータフィールドを追加します。

　その新たなデータフィールドの Functionプロパティには xlCount を代入します。

　「人数」の場合と同じ数え上げです。

　ただ、それだけではパーセンテージにならないので
Calculationプロパティに値を代入します。
今回は xlPercentOfRow を代入。

　これは、「行」における構成比を算出するものです。

　横方向をたどって右端にある「総計」を100％とする値になります。

　新たなデータフィールドを設定する部分の VBAコードを掲げます。

With ptObj.PivotFields("ＩＤ")
    .Orientation = xlDataField
    .Function = xlCount
    .Caption = "構成比"
    .Calculation = xlPercentOfRow  ' 「行」における構成比
    .NumberFormat = "0.0%"
End With
ptObj.DataPivotField.Orientation = xlRowField

　最後の１行は、データフィールドを横方向でなく縦方向に拡げるための指定です。

　つまり、「構成比」を「人数」の下に配置するためのものです。

　Calculationプロパティにセットできる値には次のものがあるようです。

　以下に出てくる「基準フィールド」とか「基準アイテム」については、別の機会に触れたいとおもいます。

xlNoAdditionalCalculation　-4143

計算は行わない

xlDifferenceFrom　2

[基準フィールド] の [基準アイテム] の値との差分

xlPercentOf　3

[基準フィールド] の [基準アイテム] の値のパーセンテージ

xlPercentDifferenceFrom　4

[基準フィールド] の [基準アイテム] の値との差分のパーセンテージ

xlRunningTotal　5

累計としての [基準フィールド] 内の連続するアイテムのデータ

xlPercentOfRow　6

行または項目の合計のパーセンテージ

xlPercentOfColumn　7

列または系列の合計のパーセンテージ

xlPercentOfTotal　8

レポートのすべてのデータまたはデータ要素の総計に対するパーセンテージ

xlIndex　9

((セルの値) × (総計)) / ((行の総計) × (列の総計)) で計算されたデータ

xlPercentOfParentRow　10

親行の合計のパーセンテージ

xlPercentOfParentColumn　11

親列の合計のパーセンテージ

xlPercentOfParent　12

指定した親の [基準フィールド] の合計のパーセンテージ

xlPercentRunningTotal　13

指定した [基準フィールド] の累計のパーセンテージ

xlRankAscending　14

昇順での順位

xlRankDecending　15

降順での順位

目次に戻る

(3)　性別を加味したクロス集計

　ソースデータには「性別」の列があります。

　身長の分布が性別によってどう違うかをみるため、クロス集計表を作成します。

　下のような表です。

　今回は身長区分を縦方向に配置しました。

　クロス集計する場合は、列フィールドと行フィールドの両方を設定します。

　列フィールドが「性別」、行フィールドが「身長」です。

　そのほか、人数をカウントするため「ＩＤ」をデータフィールドに指定します。

　これらピボットフィールドを設定する VBAコードは次のとおり。

With ptObj.PivotFields("性別")
    .Orientation = xlColumnField
    .LabelRange.Value = .Name
    .PivotItems("女性").Position = 2
    .PivotItems("男性").Position = 1
    .PivotItems(3).Name = "記載なし"
End With
With ptObj.PivotFields("身長")
    .Orientation = xlRowField
    .LabelRange.Value = .Name & "区分"
    .DataRange.Cells(1).Group Start:=140.0, By:=10.0
    iName = .PivotItems(1).Name  ' 第1アイテムの名前
    For i = 2 To .PivotItems.Count  ' 第2以降の順序を繰り上げ
        .PivotItems(i).Position = i - 1
    Next
    .PivotItems(iName).Position = .PivotItems.Count  ' 第1だったのを最後に
    .PivotItems(iName).Name = "記載なし"
End With
With ptObj.PivotFields("ＩＤ")
    .Orientation = xlDataField
    .Function = xlCount
    .Caption = "人数(性別×身長)"
End With
ptObj.DisplayNullString = True
ptObj.NullString = "0"

　上記のピボットフィールドの設定については、これまで述べてきたノウハウを用いているだけです。特に付け加えることはありません。

　最後の２行は、空欄に数字の0を入れるためのものです。

ptObj.DisplayNullString = True
ptObj.NullString = "0"

　この２行がないと、集計表の中にいくつか空欄ができます。

　「性別」に記載のない人は２人だけなので、多くの身長区分の欄が空欄になります。数え上げができないので空欄になる訳です。

　空欄のままでもいいのですが、一応 0 を入れてみました。

　ptObj.NullString = "0" と書いておくと空欄に 0 が入ります。

　ただし、ptObj.DisplayNullString に False が代入されていると 0 が入りません。なので True を代入しています。

　デフォルト値が True なので書く必要はないかもしれませんが、念のため。

　長くなるのでここには掲載しませんが、クロス集計表を作るための VBAマクロ、VBScript、JScript をzip圧縮ファイルに入れてあります。

　また、クロス集計表に人数と構成比の両方を入れるケースもzipに同梱してあります。興味があったら のぞいてみて下さい。

〜　以上　〜