異なるフィールド構成のテーブル結合と集計

2017/09/10

ExcelVBAとピボットテーブル：第８回　外部データの利用 に関連する VBAマクロ、VBScript、JScriptを掲載します。

　その第３弾「異なるフィールド構成のテーブル結合と集計」です。

　なお、ここに掲載するのは xlsファイルを処理するサンプルです。

　accdbファイルを処理するサンプルは、zip圧縮ファイルに入っているものを参照してください。

　　　　

《このページの目次》

　　　　

1.　VBAマクロ

 1Option Explicit
 2Sub Macro1()
 3    Dim pName As String, srcPath As String
 4    Dim ptCache As PivotCache, ptObj As PivotTable
 5    Dim cnn As String, sql As String
 6    Dim vObj, i As Integer
 7
 8    pName = ThisWorkbook.Path  ' 本ワークブックのフォルダ名
 9    srcPath = pName & "\..\data\pt_source03.xls"  ' ソースデータのパス
10    cnn = "ODBC;DSN=Excel Files;DBQ=" & srcPath  ' 接続用文字列
11    sql = "SELECT [性別データ$].ＩＤ, [性別データ$].性別, " & _
12        "[意見データ$].意見" & vbNewLine & _
13        "FROM [性別データ$], [意見データ$]" & vbNewLine & _
14        "WHERE [性別データ$].ＩＤ = [意見データ$].ＩＤ;"
15
16    WorkSheets(1).Activate  ' 第１シートをアクティブに
17    Set ptCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlExternal)
18    ptCache.Connection = cnn
19    ptCache.CommandText = sql
20    Set ptObj = ptCache.CreatePivotTable( _
21        TableDestination:="R1C1", TableName:="ピボット01")
22
23    With ptObj.PivotFields("性別")
24        .Orientation = xlRowField
25        .LabelRange.Value = "性別"
26        i = 0
27        For Each vObj In Array("男性", "女性")
28            i = i + 1
29            .PivotItems(vObj).Position = i
30        Next
31    End With
32    With ptObj.PivotFields("意見")
33        .Orientation = xlColumnField
34        i = 0
35        For Each vObj In Array("賛成", "反対", "保留")
36            i = i + 1
37            .PivotItems(vObj).Position = i
38        Next
39        .LabelRange.Value = "意見"
40    End With
41    With ptObj.PivotFields("ＩＤ")
42        .Orientation = xlDataField
43        .Function = xlCount
44        .Caption = "人数"
45    End With
46    With ptObj.PivotFields("ＩＤ")
47        .Orientation = xlDataField
48        .Function = xlCount
49            .Caption = "構成比"
50            .Calculation = xlPercentOfRow  ' 「行」における構成比
51            .NumberFormat = "0.0%"
52    End With
53End Sub

目次に戻る

2.　VBScript

 1Option Explicit
 2Dim fso, bookPath, srcPath
 3Dim exlApp, wbObj
 4Dim ptCache, ptObj
 5Dim cnn, sql, vObj, i
 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("..\data\pt_source03.xls")
12cnn = "ODBC;DSN=Excel Files;DBQ=" & srcPath
13sql = "SELECT [性別データ$].ＩＤ, [性別データ$].性別, " & _
14    "[意見データ$].意見" & vbNewLine & _
15    "FROM [性別データ$], [意見データ$]" & vbNewLine & _
16    "WHERE [性別データ$].ＩＤ = [意見データ$].ＩＤ;"
17
18Set exlApp = CreateObject("Excel.Application")  ' Excelの起動
19exlApp.Visible = True  ' Excelを見える状態に
20Set wbObj = exlApp.Workbooks.Add()  ' Workbookの新規作成
21wbObj.WorkSheets(1).Activate
22Set ptCache = wbObj.PivotCaches.Create(xlExternal)
23ptCache.Connection = cnn
24ptCache.CommandText = sql
25Set ptObj = ptCache.CreatePivotTable( _
26    "R1C1", "ピボット01")
27
28With ptObj.PivotFields("性別")
29    .Orientation = xlRowField
30    .LabelRange.Value = "性別"
31    i = 0
32    For Each vObj In Array("男性", "女性")
33        i = i + 1
34        .PivotItems(vObj).Position = i
35    Next
36End With
37With ptObj.PivotFields("意見")
38    .Orientation = xlColumnField
39    i = 0
40    For Each vObj In Array("賛成", "反対", "保留")
41        i = i + 1
42        .PivotItems(vObj).Position = i
43    Next
44    .LabelRange.Value = "意見"
45End With
46With ptObj.PivotFields("ＩＤ")
47    .Orientation = xlDataField
48    .Function = xlCount
49    .Caption = "人数"
50End With
51With ptObj.PivotFields("ＩＤ")
52    .Orientation = xlDataField
53    .Function = xlCount
54        .Caption = "構成比"
55        .Calculation = xlPercentOfRow  ' 「行」における構成比
56        .NumberFormat = "0.0%"
57End With
58wbObj.SaveAs bookPath, xlOpenXMLWorkbook
59exlApp.quit
60
61Sub SetDataFld(ByRef ptFld, ByVal funcVal, ByVal capName, ByVal numFmt)
62    With ptFld
63        .Orientation = xlDataField
64        If Not IsMissing(funcVal) Then  .Function = funcVal
65        If Not IsMissing(capName) Then  .Caption = capName
66        If Not IsNull(numFmt) Then .NumberFormat = numFmt
67    End With
68End Sub
69
70Function IsMissing(p)
71    IsMissing = (VarType(p) = vbError)
72End Function
73
74Sub Include(ByVal FileName)
75    Dim fso, FileObj, MyStr
76    Set fso = CreateObject("Scripting.FileSystemObject") 
77    Set FileObj = fso.OpenTextFile(fso.GetAbsolutePathName(FileName))
78    MyStr = FileObj.ReadAll()
79    FileObj.Close
80    Set fso = Nothing
81    Set FileObj = Nothing
82    ExecuteGlobal MyStr
83End Sub

目次に戻る

3.　JScript

 1var fso, bookPath, srcPath;
 2var exlApp, wb;
 3var ptCache, ptObj;
 4var cnn, sql, vAry, i;
 5var newLine = "\r\n";
 6eval(ReadFile("constants_xl.js"));
 7
 8fso = WScript.CreateObject("Scripting.FileSystemObject");
 9bookPath = fso.GetAbsolutePathName("Book1.xlsx");
10if (fso.FileExists(bookPath))  fso.DeleteFile(bookPath);
11srcPath = fso.GetAbsolutePathName("..\\data\\pt_source03.xls");
12cnn = "ODBC;DSN=Excel Files;DBQ=" + srcPath;
13sql = "SELECT [性別データ$].ＩＤ, [性別データ$].性別, " +
14    "[意見データ$].意見" + newLine +
15    "FROM [性別データ$], [意見データ$]" + newLine +
16    "WHERE [性別データ$].ＩＤ = [意見データ$].ＩＤ;";
17
18exlApp = WScript.CreateObject("Excel.Application");  // Excelの起動
19exlApp.Visible = true;  // Excelを見える状態に
20wb = exlApp.Workbooks.Add();  // Workbookの新規作成
21wb.WorkSheets(1).Activate;
22
23ptCache = wb.PivotCaches().Create(xlExternal);
24ptCache.Connection = cnn;
25ptCache.CommandText = sql;
26ptObj = ptCache.CreatePivotTable(
27    "R1C1", "ピボット01");
28
29with (ptObj.PivotFields("性別")) {
30    Orientation = xlRowField;
31    LabelRange.Value = "性別";
32    vAry = ["男性", "女性"];
33    for(i = 0; i < vAry.length; i++) {
34        PivotItems(vAry[i]).Position = i+1;
35    }
36}
37with (ptObj.PivotFields("意見")) {
38    Orientation = xlColumnField;
39    vAry = ["賛成", "反対", "保留"];
40    for(i = 0; i < vAry.length; i++) {
41        PivotItems(vAry[i]).Position = i+1;
42    }
43    LabelRange.Value = "意見";
44}
45with (ptObj.PivotFields("ＩＤ")) {
46    Orientation = xlDataField;
47    Function = xlCount;
48    Caption = "人数";
49}
50with (ptObj.PivotFields("ＩＤ")) {
51    Orientation = xlDataField;
52    Function = xlCount;
53        Caption = "構成比";
54        Calculation = xlPercentOfRow;  // 「行」における構成比
55        NumberFormat = "0.0%";
56}
57wb.SaveAs(bookPath, xlOpenXMLWorkbook);
58exlApp.Quit();
59
60function ReadFile(filename) {
61    var fso = WScript.CreateObject("Scripting.FileSystemObject");
62    var path = fso.GetAbsolutePathName(filename);
63    var MyStr = null;
64    if (fso.FileExists(path)) {
65        var fobj = fso.OpenTextFile(path, 1);
66        MyStr = fobj.ReadAll();
67        fobj.Close();
68    }
69    return MyStr;
70}

〜　以上　〜