同一フィールド構成のテーブル結合と集計

2017/09/10

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

　その第２弾「同一フィールド構成のテーブル結合と集計」です。

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

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

　また、クエリテーブルの処理についても 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_source02.xls"  ' ソースデータのパス
10    cnn = "ODBC;DSN=Excel Files;DBQ=" & srcPath  ' 接続用文字列
11    sql = _
12        "SELECT '東京支店' AS 支店, * FROM [東京支店$]" & _
13        vbNewLine & "UNION ALL" & vbNewLine & _
14        "SELECT '名古屋支店' AS 支店, * FROM [名古屋支店$]" & _
15        vbNewLine & "UNION ALL" & vbNewLine & _
16        "SELECT '大阪支店' AS 支店, * FROM [大阪支店$]"
17
18    WorkSheets(1).Activate  ' 第１シートをアクティブに
19    Set ptCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlExternal)
20    ptCache.Connection = cnn
21    ptCache.CommandText = sql
22    Set ptObj = ptCache.CreatePivotTable( _
23        TableDestination:="R1C1", TableName:="ピボット01")
24
25    With ptObj.PivotFields("支店")
26        .Orientation = xlColumnField
27        .LabelRange.Value = "支店"
28        i = 0
29        For Each vObj In Array("東京支店", "名古屋支店", "大阪支店")
30            i = i + 1
31            .PivotItems(vObj).Position = i
32        Next
33    End With
34    With ptObj.PivotFields("商品")
35        .Orientation = xlRowField
36        i = 0
37        For Each vObj In Array("調味料", "飲料", "乳製品", "魚介類")
38            i = i + 1
39            .PivotItems(vObj).Position = i
40        Next
41        .LabelRange.Value = "商品"
42    End With
43    With ptObj.PivotFields("売上")
44        .Orientation = xlDataField
45        .Function = xlSum
46        .NumberFormat = "#,##0"
47    End With
48End 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_source02.xls")
12cnn = "ODBC;DSN=Excel Files;DBQ=" & srcPath
13sql = _
14    "SELECT '東京支店' AS 支店, * FROM [東京支店$]" & _
15    vbNewLine & "UNION ALL" & vbNewLine & _
16    "SELECT '名古屋支店' AS 支店, * FROM [名古屋支店$]" & _
17    vbNewLine & "UNION ALL" & vbNewLine & _
18    "SELECT '大阪支店' AS 支店, * FROM [大阪支店$]"
19
20Set exlApp = CreateObject("Excel.Application")  ' Excelの起動
21exlApp.Visible = True  ' Excelを見える状態に
22Set wbObj = exlApp.Workbooks.Add()  ' Workbookの新規作成
23wbObj.WorkSheets(1).Activate
24Set ptCache = wbObj.PivotCaches.Create(xlExternal)
25ptCache.Connection = cnn
26ptCache.CommandText = sql
27Set ptObj = ptCache.CreatePivotTable( _
28    "R1C1", "ピボット01")
29
30With ptObj.PivotFields("支店")
31    .Orientation = xlColumnField
32    .LabelRange.Value = "支店"
33    i = 0
34    For Each vObj In Array("東京支店", "名古屋支店", "大阪支店")
35        i = i + 1
36        .PivotItems(vObj).Position = i
37    Next
38End With
39With ptObj.PivotFields("商品")
40    .Orientation = xlRowField
41    i = 0
42    For Each vObj In Array("調味料", "飲料", "乳製品", "魚介類")
43        i = i + 1
44        .PivotItems(vObj).Position = i
45    Next
46    .LabelRange.Value = "商品"
47End With
48With ptObj.PivotFields("売上")
49    .Orientation = xlDataField
50    .Function = xlSum
51    .NumberFormat = "#,##0"
52End With
53wbObj.SaveAs bookPath, xlOpenXMLWorkbook
54exlApp.quit
55
56Sub SetDataFld(ByRef ptFld, ByVal funcVal, ByVal capName, ByVal numFmt)
57    With ptFld
58        .Orientation = xlDataField
59        If Not IsMissing(funcVal) Then  .Function = funcVal
60        If Not IsMissing(capName) Then  .Caption = capName
61        If Not IsNull(numFmt) Then .NumberFormat = numFmt
62    End With
63End Sub
64
65Function IsMissing(p)
66    IsMissing = (VarType(p) = vbError)
67End Function
68
69Sub Include(ByVal FileName)
70    Dim fso, FileObj, MyStr
71    Set fso = CreateObject("Scripting.FileSystemObject") 
72    Set FileObj = fso.OpenTextFile(fso.GetAbsolutePathName(FileName))
73    MyStr = FileObj.ReadAll()
74    FileObj.Close
75    Set fso = Nothing
76    Set FileObj = Nothing
77    ExecuteGlobal MyStr
78End 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_source02.xls");
12cnn = "ODBC;DSN=Excel Files;DBQ=" + srcPath;
13sql = 
14    "SELECT '東京支店' AS 支店, * FROM [東京支店$]" +
15    newLine + "UNION ALL" + newLine +
16    "SELECT '名古屋支店' AS 支店, * FROM [名古屋支店$]" +
17    newLine + "UNION ALL" + newLine +
18    "SELECT '大阪支店' AS 支店, * FROM [大阪支店$]";
19
20exlApp = WScript.CreateObject("Excel.Application");  // Excelの起動
21exlApp.Visible = true;  // Excelを見える状態に
22wb = exlApp.Workbooks.Add();  // Workbookの新規作成
23wb.WorkSheets(1).Activate;
24
25ptCache = wb.PivotCaches().Create(xlExternal);
26ptCache.Connection = cnn;
27ptCache.CommandText = sql;
28ptObj = ptCache.CreatePivotTable(
29    "R1C1", "ピボット01");
30
31with (ptObj.PivotFields("支店")) {
32    Orientation = xlColumnField;
33    LabelRange.Value = "支店";
34    vAry = ["東京支店", "名古屋支店", "大阪支店"];
35    for(i = 0; i < vAry.length; i++) {
36        PivotItems(vAry[i]).Position = i + 1;
37    }
38}
39with (ptObj.PivotFields("商品")) {
40    Orientation = xlRowField;
41    vAry = ["調味料", "飲料", "乳製品", "魚介類"];
42    for(i = 0; i < vAry.length; i++) {
43        PivotItems(vAry[i]).Position = i + 1;
44    }
45    LabelRange.Value = "商品";
46}
47with (ptObj.PivotFields("売上")) {
48    Orientation = xlDataField;
49    Function = xlSum;
50    NumberFormat = "#,##0";
51}
52wb.SaveAs(bookPath, xlOpenXMLWorkbook);
53exlApp.Quit();
54
55function ReadFile(filename) {
56    var fso = WScript.CreateObject("Scripting.FileSystemObject");
57    var path = fso.GetAbsolutePathName(filename);
58    var MyStr = null;
59    if (fso.FileExists(path)) {
60        var fobj = fso.OpenTextFile(path, 1);
61        MyStr = fobj.ReadAll();
62        fobj.Close();
63    }
64    return MyStr;
65}

〜　以上　〜