ExcelVBAとピボットテーブル:第3回 プロシージャ化と複数テーブルの作成

カテゴリー名: [ExcelVBAとピボットテーブル

2017/07/30

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

 今回は、プロシージャを導入し、一つのワークシートに複数のピボットテーブルを設けます。罫線も取り上げます。

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


《このページの目次》


    

1. 最小値と最大値を表示するピボットテーブル

 次回の第4回で身長等の数値データのグループ化を取り上げる予定ですが、
その場合、「150〜160」とか「160〜170」のような範囲を設定して、
そこに所属する人数を数え上げることになります。

 それをやるには最小値と最大値を把握しておく必要があります。

 そこで、今回は最小値と最大値を表示するピボットテーブルを作成します。

(1) 「身長」の最小値・最大値を表示

 これまでのサンプルでは、データフィールドの Functionプロパティに xlAverage を指定して平均値を表示しました。

 これを xlMin にすれば最小値、xlMax なら最大値になります。

 作りたい表は下のとおり。

  身長の値  
性別 最小値 最大値
男性 151.6 185.2
女性 144.8 179.8
記載なし 161.3 167.0
全体 144.8 185.2

    

 上の表を作成する VBAマクロを掲げます。

 これまでのサンプルと共通する部分は省略して、ピボットフィールドの設定箇所のみ掲載。

    (前略)
    With ptObj.PivotFields("性別")
        .Orientation = xlRowField
        .PivotItems("女性").Position = 2
        .PivotItems("男性").Position = 1
        .PivotItems(3).Name = "記載なし"
        .LabelRange.Value = .Name  ' 「行ラベル」→「性別」
    End With
    With ptObj.PivotFields("身長")
        .Orientation = xlDataField
        .Function = xlMin
        .Caption = "最小値"
        .NumberFormat = "0.0"
    End With
    With ptObj.PivotFields("身長")
        .Orientation = xlDataField
        .Function = xlMax
        .Caption = "最大値"
        .NumberFormat = "0.0"
    End With
    (後略)

目次に戻る


(2) プロシージャの設定

 前述の VBAマクロには With ptObj.PivotFields("身長") というのが2度出てきます。そして、それに続く記述も似通っています。

 そこで、この With の箇所をプロシージャにしてマクロを簡潔にします。

 プロシージャは、たとえば下のようになります。

Sub SetDataFld(ByRef ptFld As PivotField, ByVal funcVal As Integer, _
        ByVal capName As String, ByVal numFmt As String)
    With ptFld
        .Orientation = xlDataField
        .Function = funcVal
        .Caption = capName
        .NumberFormat = numFmt
    End With
End Sub

 上のプロシージャを呼び出すためには次の2行を書きます。

SetDataFld ptObj.PivotFields("身長"), xlMin, "最小値", "0.0"
SetDataFld ptObj.PivotFields("身長"), xlMax, "最大値", "0.0"

    

 ついでに、「性別」のピボットフィールドを処理する箇所もプロシージャにしてしまいます。

Sub SetRowFld(ByRef ptFld As PivotField)
    With ptFld
        .Orientation = xlRowField
        .PivotItems("女性").Position = 2
        .PivotItems("男性").Position = 1
        .PivotItems(3).Name = "記載なし"
        .LabelRange.Value = .Name  ' 「行ラベル」→「性別」
    End With
End Sub

 上記のプロシージャを呼び出すための記述は次のとおり。

SetRowFld ptObj.PivotFields("性別")

目次に戻る


(3) VBAマクロ

 この辺で VBAマクロ全体を掲げておきます。

 身長の最小値と最大値を表示するテーブルを作ります。

 1Sub Macro1()
 2    Dim pName As String, bName As String
 3    Dim ptCache As PivotCache, ptObj As PivotTable
 4    
 5    pName = ThisWorkbook.Path  ' 本ワークブックのフォルダ名
 6    bName = ThisWorkbook.Name  ' 本ワークブックの名前
 7    Workbooks.Open pName & "\pt_source.xls"  ' ソースデータを開く
 8    Workbooks(bName).Activate  ' 本ワークブックをアクティブに
 9    WorkSheets(1).Activate  ' 第1シートをアクティブに
10    
11    Set ptCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
12        SourceData:="[pt_source.xls]Sheet1!SourceDataRange")
13    Set ptObj = ptCache.CreatePivotTable( _
14        TableDestination:="R1C1", TableName:="ピボット01")
15    SetRowFld ptObj.PivotFields("性別")
16    SetDataFld ptObj.PivotFields("身長"), xlMin, "最小値", "0.0"
17    SetDataFld ptObj.PivotFields("身長"), xlMax, "最大値", "0.0"
18    ptObj.GrandTotalName = "全体"  ' 「総計」→「全体」
19    ptObj.DataPivotField.LabelRange.Value = "身長の値"
20End Sub
21    
22Sub SetRowFld(ByRef ptFld As PivotField)
23    With ptFld
24        .Orientation = xlRowField
25        .PivotItems("女性").Position = 2
26        .PivotItems("男性").Position = 1
27        .PivotItems(3).Name = "記載なし"
28        .LabelRange.Value = .Name  ' 「行ラベル」→「性別」
29    End With
30End Sub
31    
32Sub SetDataFld(ByRef ptFld As PivotField, ByVal funcVal As Integer, _
33        ByVal capName As String, ByVal numFmt As String)
34    With ptFld
35        .Orientation = xlDataField
36        .Function = funcVal
37        .Caption = capName
38        .NumberFormat = numFmt
39    End With
40End Sub

目次に戻る


(4) 参照渡しと値渡し

 プロシージャ部分の記述で、パラメータを列記するところに ByRef と ByVal というのが出てきます。

 Sub SetDataFld(ByRef ptFld As PivotField, ByVal funcVal As Integer, ……

 ByRef は、パラメータを参照渡しで扱うことを指示します。

 ByVal は、値渡しで扱うことを指示します。

 図書館で本を貸し出す場合、原本そのものを渡すのが参照渡し、
コピーを手渡すのが値渡しです。

 プロシージャの立場でいうと、呼び出す側の Macro1 が貸す側の図書館職員、
呼び出される側の SetDataFld は図書を借りる借り手です。

 借り手が本にいろいろ書き込みをしても、コピーなら、原本がよごれません。別の借り手が書き込みを読むことはありません。

 でも、原本を貸したのなら、借りた人の書き込みが別の借り手にも読まれることになります。

 複数のプロシージャ間で情報を共有するなら参照渡しがいいでしょうし、
共有する必要がないなら値渡しが適していることになります。

 VBScript でもこの ByRef, ByVal の指定が可能です。

 一方、JScript では、ByRef, ByVal に該当する指示語がないようです。

 JScriptの場合、数値と真偽値(true, false)が値渡し、それ以外は参照渡しのようですが、少しややこしい面があるみたいです。

参考サイト: データのコピー、受け渡し、および比較

 JScriptに限らずプログラミング全般において、参照渡しと値渡しには複雑な側面がありますが、ここでは踏み込みません。

目次に戻る


2. 一つのワークシートに二つのピボットテーブル

 先の VBAマクロでは、身長の最小値と最大値を表示するテーブルを作りました。

 ここでは体重についてのテーブルを作ります。

 ワークシートを切り替えて Sheet2 に作るのが簡単ですが、見通しがきかなくなります。

 小さなテーブルなので、同じワークシートにもう一つピボットテーブルを作ることにします。

(1) ピボットテーブルが占めるセル範囲をチェック

 二つ目のピボットテーブルを作る場合、当然ながら第1のテーブルと重ならないようにしなければなりません。

 第1のテーブルがどの領域を占めているかをチェックして、それより下に第2のテーブルを設けることになります。

 ピボットテーブルオブジェクトが変数 ptObj に代入されているとき、
ptObj.TableRange1 は、ピボットテーブルが占める領域全体を表します。

 身長の最小値・最大値を示すテーブルの場合、A1:C6 を占めます。

 ptObj.TableRange1 は、Range("A1:C6") と等価です。

 だとすれば、第2のテーブルは、2行 あけて A9 から始めるのがいいでしょう。

 この A9 という開始番地を弾力的に検出しようというのがこの項の目的です。

 第1のテーブルの大きさが A1:C6 とは違うケースでも応用できるマクロにする訳です。

    

 変数 rng に Range("A1:C6") が代入されている場合、
左上端のセルの行番号が rng.Row で取得でき(数値の1が得られる)、
左上端のセルの列番号は rng.Column で取得できます(やはり数値の1)。

 残念ながら、領域の右下端のセルの番地を、ダイレクトに数値で得る方法はないようです。

 rng.Rows.Count で領域の行数、rng.Columns.Count で領域の列数が得られるので、これを材料にして計算します。

 rng.Row + rng.Rows.Count - 1 によって、領域の最後の行の行番号が得られます。

 第1のピボットテーブルの最後の行の番号を算出するマクロ記述は次の2行です。

Set rng = ptObj.TableRange1
rNum = rng.Row + rng.Rows.Count - 1

 上のようにすると、変数 rNum に 6 が代入されます。

 第2のピボットテーブルの開始位置は、Cells(rNum+3,1) とすれば大丈夫です。

目次に戻る


(2) 「体重」についてのピボットテーブルを設ける

 体重についてのピボットテーブルを作成しますが、これは身長の集計を行ったのと同じソースデータを使います。

 なので、ピボットキャッシュを別途設定する必要はありません。

 同じピボットキャッシュから、もう一つピボットテーブルを創出します。

 最小値と最大値だけでなく、平均値と標本標準偏差(SD)も表示するようにします。

 プロシージャを設けたので、比較的簡単に追加できます。

 できれば中央値も盛り込みたいところですが難しいようです。

 以下に「体重」のピボットテーブルを作成する部分の VBAマクロを掲げます。

    

Set rng = ptObj.TableRange1
rNum = rng.Row + rng.Rows.Count - 1
Set ptObj2 = ptCache.CreatePivotTable( _
    TableDestination:=Cells(rNum+3,1), TableName:="ピボット02")
SetRowFld ptObj2.PivotFields("性別")
SetDataFld ptObj2.PivotFields("体重"), xlMin, "最小値", "0.0"
SetDataFld ptObj2.PivotFields("体重"), xlAverage, "平均値", "0.0"
SetDataFld ptObj2.PivotFields("体重"), xlStDev, "SD", "??.??"
SetDataFld ptObj2.PivotFields("体重"), xlMax, "最大値", "0.0"
ptObj2.GrandTotalName = "全体"  ' 「総計」→「全体」
ptObj2.DataPivotField.LabelRange.Value = "体重の値"

目次に戻る


(3) ピボットテーブルに罫線を付ける

 身長と体重の表を別々に設けるので、見やすくするために罫線を付けます。

 罫線の引き方は、一般的な Rangeオブジェクトの Borders や BorderAround で行います。

 変数 ptObj にピボットテーブルオブジェクトが代入されている場合、
ptObj.TableRange1 でピボットテーブルの Range を取得できるので、
好みの形で Borders を設定すればOKです。

 次のように書けば、テーブルの各セルに実線の格子罫線を引くことになります。

ptObj.TableRange1.Borders.LineStyle = xlContinuous

 更に、表の外枠を太い線にするなら次の1行も加えます。

ptObj.TableRange1.BorderAround Weight:=xlMedium

    

 今回の表では、データフィールドのラベル 「身長の値」および「体重の値」が1行の中に一つだけぽつんとあるかたちです。

 これを罫線の外に置きたい場合は Range の範囲を調整する必要があります。

 一番上の1行を Range から外して罫線を引くには、次のようにします。

Set rng = ptObj.TableRange1
With rng.Offset(1).Resize(rng.Rows.Count - 1)
    .Borders.LineStyle = xlContinuous
    .BorderAround Weight:=xlMedium
End With

 Offsetは、Rangeの開始位置をずらして新しいRangeを返します。

 Offset(1,3) とすれば、下に1行・右に三列だけずれます。

 このとき、Rangeの大きさは変化しません。Rangeの右下端も同じだけずれます。

 Offset(1)Offset(1,0) と同じ意味です。

 Resize は Range の大きさ(行数と列数)を再設定して新しいRangeを返します。

 Resize(5, 7) だと、Rangeが5行・七列の大きさになります。

目次に戻る


3. VBAマクロ

 これまで述べてきた事柄を一通り盛り込んだ VBAマクロを掲げます。

 身長と体重の二つのピボットテーブルを作成し、罫線を付けます。

 最小値、平均値、標本標準偏差(SD)、最大値を表示。

 なお、Macro1 以外のプロシージャは既に掲載しているので省略。

 1Sub Macro1()
 2    Dim pName As String, bName As String
 3    Dim ptCache As PivotCache, ptObj As PivotTable, ptObj2 As PivotTable
 4    Dim rng As Range, rNum As Long
 5    
 6    pName = ThisWorkbook.Path  ' 本ワークブックのフォルダ名
 7    bName = ThisWorkbook.Name  ' 本ワークブックの名前
 8    Workbooks.Open pName & "\pt_source.xls"  ' ソースデータを開く
 9    Workbooks(bName).Activate  ' 本ワークブックをアクティブに
10    WorkSheets(1).Activate  ' 第1シートをアクティブに
11    
12    Set ptCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
13        SourceData:="[pt_source.xls]Sheet1!SourceDataRange")
14    Set ptObj = ptCache.CreatePivotTable( _
15        TableDestination:="R1C1", TableName:="ピボット01")
16    SetRowFld ptObj.PivotFields("性別")
17    SetDataFld ptObj.PivotFields("身長"), xlMin, "最小値", "0.0"
18    SetDataFld ptObj.PivotFields("身長"), xlAverage, "平均値", "0.0"
19    SetDataFld ptObj.PivotFields("身長"), xlStDev, "SD", "??.??"
20    SetDataFld ptObj.PivotFields("身長"), xlMax, "最大値", "0.0"
21    ptObj.GrandTotalName = "全体"  ' 「総計」→「全体」
22    ptObj.DataPivotField.LabelRange.Value = "身長の値"
23    Set rng = ptObj.TableRange1  ' ピボットテーブル領域全体を得る
24    With rng.Offset(1).Resize(rng.Rows.Count - 1)  ' 二行目以降に罫線付加
25        .Borders.LineStyle = xlContinuous  ' 実線の格子罫線
26        .BorderAround Weight:=xlMedium  ' 外枠を太線
27    End With
28    
29    Set rng = ptObj.TableRange1
30    rNum = rng.Row + rng.Rows.Count - 1  ' ピボットテーブルの最終行番号
31        ' これ以降で二つ目のピボットテーブルを作成
32    Set ptObj2 = ptCache.CreatePivotTable( _
33        TableDestination:=Cells(rNum+3,1), TableName:="ピボット02")
34    SetRowFld ptObj2.PivotFields("性別")
35    SetDataFld ptObj2.PivotFields("体重"), xlMin, "最小値", "0.0"
36    SetDataFld ptObj2.PivotFields("体重"), xlAverage, "平均値", "0.0"
37    SetDataFld ptObj2.PivotFields("体重"), xlStDev, "SD", "??.??"
38    SetDataFld ptObj2.PivotFields("体重"), xlMax, "最大値", "0.0"
39    ptObj2.GrandTotalName = "全体"  ' 「総計」→「全体」
40    ptObj2.DataPivotField.LabelRange.Value = "体重の値"
41    Set rng = ptObj2.TableRange1
42    With rng.Offset(1).Resize(rng.Rows.Count - 1)
43        .Borders.LineStyle = xlContinuous
44        .BorderAround Weight:=xlMedium
45    End With
46End Sub

目次に戻る


4. VBScript

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

 スクリプトにより作成される Book1.xlsx を開くと、二つのピボットテーブルがあるはずです。

 二つ目のピボットテーブルの開始位置を指定するのに VBAマクロでは
Cells(rNum+3,1) とだけ書きましたが、VBScript ではそういう訳にいきません。

 exlApp.ActiveSheet.Cells(rNum+3,1) のように書きます。

 それから、外枠罫線用の BorderAround の規定のパラメータは次のとおりです。

BorderAround(LineStyle, Weight, ColorIndex, Color, ThemeColor)

 今回は2番目の Weight を指定するので、VBAマクロとは違って VBScript用の記述をします。

    

 1Option Explicit
 2Dim fso, bookPath, srcPath
 3Dim exlApp, wbObj
 4Dim ptCache, ptObj, ptObj2
 5Dim rng, rNum
 6Include "constants_xl.vbs"
 7    
 8Set fso = CreateObject("Scripting.FileSystemObject")
 9bookPath = fso.GetAbsolutePathName("Book1.xlsx")
10If (fso.FileExists(bookPath) = True) Then fso.DeleteFile(bookPath)
11srcPath = fso.GetAbsolutePathName("pt_source.xls")
12Set exlApp = CreateObject("Excel.Application")  ' Excelの起動
13exlApp.Visible = True  ' Excelを見える状態に
14exlApp.Workbooks.Open srcPath
15Set wbObj = exlApp.Workbooks.Add()  ' Workbookの新規作成
16wbObj.WorkSheets(1).Activate
17    
18Set ptCache = wbObj.PivotCaches.Create(xlDatabase, _
19    "[pt_source.xls]Sheet1!SourceDataRange")
20Set ptObj = ptCache.CreatePivotTable( _
21    "R1C1", "ピボット01")
22SetRowFld ptObj.PivotFields("性別")
23SetDataFld ptObj.PivotFields("身長"), xlMin, "最小値", "0.0"
24SetDataFld ptObj.PivotFields("身長"), xlAverage, "平均値", "0.0"
25SetDataFld ptObj.PivotFields("身長"), xlStDev, "SD", "??.??"
26SetDataFld ptObj.PivotFields("身長"), xlMax, "最大値", "0.0"
27ptObj.GrandTotalName = "全体"  ' 「総計」→「全体」
28ptObj.DataPivotField.LabelRange.Value = "身長の値"
29Set rng = ptObj.TableRange1  ' ピボットテーブル領域全体を得る
30With rng.Offset(1).Resize(rng.Rows.Count - 1)  ' 二行目以降に罫線付加
31    .Borders.LineStyle = xlContinuous  ' 実線の格子罫線
32    .BorderAround ,xlMedium  ' 外枠を太線
33End With
34    
35Set rng = ptObj.TableRange1
36rNum = rng.Row + rng.Rows.Count - 1  ' ピボットテーブルの最終行番号
37    ' これ以降で二つ目のピボットテーブルを作成
38Set ptObj2 = ptCache.CreatePivotTable( _
39    exlApp.ActiveSheet.Cells(rNum+3,1), "ピボット02")
40SetRowFld ptObj2.PivotFields("性別")
41SetDataFld ptObj2.PivotFields("体重"), xlMin, "最小値", "0.0"
42SetDataFld ptObj2.PivotFields("体重"), xlAverage, "平均値", "0.0"
43SetDataFld ptObj2.PivotFields("体重"), xlStDev, "SD", "??.??"
44SetDataFld ptObj2.PivotFields("体重"), xlMax, "最大値", "0.0"
45ptObj2.GrandTotalName = "全体"  ' 「総計」→「全体」
46ptObj2.DataPivotField.LabelRange.Value = "体重の値"
47Set rng = ptObj2.TableRange1
48With rng.Offset(1).Resize(rng.Rows.Count - 1)
49    .Borders.LineStyle = xlContinuous
50    .BorderAround ,xlMedium
51End With
52wbObj.SaveAs bookPath, xlOpenXMLWorkbook
53exlApp.quit
54    
55Sub SetRowFld(ByRef ptFld)
56    With ptFld
57        .Orientation = xlRowField
58        .PivotItems("女性").Position = 2
59        .PivotItems("男性").Position = 1
60        .PivotItems(3).Name = "記載なし"
61        .LabelRange.Value = .Name  ' 「行ラベル」→「性別」
62    End With
63End Sub
64    
65Sub SetDataFld(ByRef ptFld, ByVal funcVal, ByVal capName, ByVal numFmt)
66    With ptFld
67        .Orientation = xlDataField
68        .Function = funcVal
69        .Caption = capName
70        .NumberFormat = numFmt
71    End With
72End Sub

目次に戻る


5. JScript

 前述の VBScript と同じ働きをする JScript を掲げます。

 VBAでいうプロシージャは function { …… } という形で記述します。

 1var fso, bookPath, srcPath;
 2var exlApp, wb;
 3var ptCache, ptObj, ptObj2;
 4var rng, rNum;
 5eval(ReadFile("constants_xl.js"));
 6    
 7fso = WScript.CreateObject("Scripting.FileSystemObject");
 8bookPath = fso.GetAbsolutePathName("Book1.xlsx");
 9if (fso.FileExists(bookPath))  fso.DeleteFile(bookPath);
10srcPath = fso.GetAbsolutePathName("pt_source.xls");
11exlApp = WScript.CreateObject("Excel.Application");  // Excelの起動
12exlApp.Visible = true;  // Excelを見える状態に
13exlApp.Workbooks.Open(srcPath);
14wb = exlApp.Workbooks.Add();  // Workbookの新規作成
15wb.WorkSheets(1).Activate();
16    
17ptCache = wb.PivotCaches().Create(xlDatabase,
18    "[pt_source.xls]Sheet1!SourceDataRange");
19ptObj = ptCache.CreatePivotTable(
20    "R1C1", "ピボット01");
21SetRowFld(ptObj.PivotFields("性別"));
22SetDataFld(ptObj.PivotFields("身長"), xlMin, "最小値", "0.0");
23SetDataFld(ptObj.PivotFields("身長"), xlAverage, "平均値", "0.0");
24SetDataFld(ptObj.PivotFields("身長"), xlStDev, "SD", "??.??");
25SetDataFld(ptObj.PivotFields("身長"), xlMax, "最大値", "0.0");
26ptObj.GrandTotalName = "全体";  // 「総計」→「全体」
27ptObj.DataPivotField.LabelRange.Value = "身長の値";
28rng = ptObj.TableRange1;  // ピボットテーブル領域全体を得る
29with (rng.Offset(1).Resize(rng.Rows.Count - 1)) {  // 二行目以降に罫線付加
30    Borders.LineStyle = xlContinuous;  // 実線の格子罫線
31    BorderAround(null, xlMedium);  // 外枠を太線
32}
33    
34rng = ptObj.TableRange1;
35rNum = rng.Row + rng.Rows.Count - 1;  // ピボットテーブルの最終行番号
36    // これ以降で二つ目のピボットテーブルを作成
37ptObj2 = ptCache.CreatePivotTable(
38    exlApp.ActiveSheet.Cells(rNum+3,1), "ピボット02");
39SetRowFld(ptObj2.PivotFields("性別"));
40SetDataFld(ptObj2.PivotFields("体重"), xlMin, "最小値", "0.0");
41SetDataFld(ptObj2.PivotFields("体重"), xlAverage, "平均値", "0.0");
42SetDataFld(ptObj2.PivotFields("体重"), xlStDev, "SD", "??.??");
43SetDataFld(ptObj2.PivotFields("体重"), xlMax, "最大値", "0.0");
44ptObj2.GrandTotalName = "全体";
45ptObj2.DataPivotField.LabelRange.Value = "体重の値";
46rng = ptObj2.TableRange1;
47with (rng.Offset(1).Resize(rng.Rows.Count - 1)) {
48    Borders.LineStyle = xlContinuous;
49    BorderAround(null, xlMedium);
50}
51wb.SaveAs(bookPath, xlOpenXMLWorkbook);
52exlApp.Quit();
53    
54function SetRowFld(ptFld) {
55    with (ptFld) {
56        Orientation = xlRowField;
57        PivotItems("女性").Position = 2;
58        PivotItems("男性").Position = 1;
59        PivotItems(3).Name = "記載なし";
60        LabelRange.Value = Name;  // 「行ラベル」→「性別」
61    }
62}
63    
64function SetDataFld(ptFld, funcVal, capName, numFmt) {
65    with (ptFld) {
66        Orientation = xlDataField;
67        Function = funcVal;
68        Caption = capName;
69        NumberFormat = numFmt
70    }
71}

〜 以上 〜