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

2017/09/02

ExcelVBAとピボットテーブル：第７回　列範囲のグループ化および二段階集計 に関連する VBAマクロ、VBScript、JScriptを掲載します。

　その第一弾「基本形」です。

　　　　

《このページの目次》

　　　　

1.　VBAマクロ

 1Option Explicit
 2Option Base 1  ' 配列の添え字を 1 から始める
 3Sub Macro1()
 4    Dim pName As String, bName As String
 5    Dim ws As WorkSheet, areaName As String
 6    Dim ptCache As PivotCache, ptObj As PivotTable
 7    Dim vObj As Variant, i As Integer
 8
 9    pName = ThisWorkbook.Path  ' 本ワークブックのフォルダ名
10    bName = ThisWorkbook.Name  ' 本ワークブックの名前
11    Workbooks.Open pName & "\pt_source02.xls"  ' ソースデータを開く
12    Set ws = WorkSheets(1)
13    areaName = "[pt_source02.xls]" & ws.Name & "!" & ws.UsedRange.Address
14    Workbooks(bName).Activate  ' 本ワークブックをアクティブに
15    WorkSheets(1).Activate  ' 第１シートをアクティブに
16
17    Set ptCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
18        SourceData:=areaName)
19    Set ptObj = ptCache.CreatePivotTable( _
20        TableDestination:="R1C1", TableName:="ピボット01")
21
22    With ptObj.PivotFields("商品")
23        .Orientation = xlColumnField
24        .LabelRange.Value = "商品"
25        i = 0
26        For Each vObj In Array("調味料", "飲料", "乳製品", "魚介類")
27            i = i + 1
28            .PivotItems(vObj).Position = i
29        Next
30        Application.Union(.PivotItems(1).LabelRange, _
31            .PivotItems(2).LabelRange).Group
32        Application.Union(.PivotItems(3).LabelRange, _
33            .PivotItems(4).LabelRange).Group
34        With .ParentField
35            .PivotItems(1).Name = "種別Ａ"
36            .PivotItems(2).Name = "種別Ｂ"
37            .Subtotals(1) = True
38        End With
39    End With
40    With ptObj.PivotFields("売上")
41        .Orientation = xlDataField
42        .Function = xlSum  ' 合計を算出
43        .Caption = "売上・計"
44        .NumberFormat = "#,##0"
45    End With
46    With ptObj.PivotFields("仕入原価")
47        .Orientation = xlDataField
48        .Function = xlSum
49        .Caption = "仕入原価・計"
50        .NumberFormat = "#,##0"
51    End With
52    ptObj.DataPivotField.Orientation = xlRowField
53    ptObj.DataPivotField.Name = "合計値"
54End Sub

目次に戻る

2.　VBScript

 1Option Explicit
 2Dim fso, bookPath, srcPath
 3Dim exlApp, wbObj, ws, areaName
 4Dim ptCache, ptObj
 5Dim 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("pt_source02.xls")
12Set exlApp = CreateObject("Excel.Application")  ' Excelの起動
13exlApp.Visible = True  ' Excelを見える状態に
14exlApp.Workbooks.Open srcPath
15Set ws = exlApp.ActiveWorkbook.WorkSheets(1)
16areaName = "[pt_source02.xls]" & ws.Name & "!" & ws.UsedRange.Address
17Set wbObj = exlApp.Workbooks.Add()  ' Workbookの新規作成
18wbObj.WorkSheets(1).Activate
19
20Set ptCache = wbObj.PivotCaches.Create(xlDatabase, areaName)
21Set ptObj = ptCache.CreatePivotTable( _
22    "R1C1", "ピボット01")
23
24With ptObj.PivotFields("商品")
25    .Orientation = xlColumnField
26    .LabelRange.Value = "商品"
27    i = 0
28    For Each vObj In Array("調味料", "飲料", "乳製品", "魚介類")
29        i = i + 1
30        .PivotItems(vObj).Position = i
31    Next
32    exlApp.Union(.PivotItems(1).LabelRange, _
33        .PivotItems(2).LabelRange).Group
34    exlApp.Union(.PivotItems(3).LabelRange, _
35        .PivotItems(4).LabelRange).Group
36    With .ParentField
37        .PivotItems(1).Name = "種別Ａ"
38        .PivotItems(2).Name = "種別Ｂ"
39        .Subtotals(1) = True
40    End With
41End With
42With ptObj.PivotFields("売上")
43    .Orientation = xlDataField
44    .Function = xlSum  ' 合計の算出
45    .Caption = "売上・計"
46    .NumberFormat = "#,##0"
47End With
48With ptObj.PivotFields("仕入原価")
49    .Orientation = xlDataField
50    .Function = xlSum
51    .Caption = "仕入原価・計"
52    .NumberFormat = "#,##0"
53End With
54ptObj.DataPivotField.Orientation = xlRowField
55ptObj.DataPivotField.Name = "合計値"
56wbObj.SaveAs bookPath, xlOpenXMLWorkbook
57exlApp.quit
58
59Sub Include(ByVal FileName)
60    Dim fso, FileObj, MyStr
61    Set fso = CreateObject("Scripting.FileSystemObject") 
62    Set FileObj = fso.OpenTextFile(fso.GetAbsolutePathName(FileName))
63    MyStr = FileObj.ReadAll()
64    FileObj.Close
65    Set fso = Nothing
66    Set FileObj = Nothing
67    ExecuteGlobal MyStr
68End Sub

目次に戻る

3.　JScript

 1var fso, bookPath, srcPath;
 2var exlApp, wb, ws, areaName;
 3var ptCache, ptObj, vAry, i;
 4eval(ReadFile("constants_xl.js"));
 5
 6fso = WScript.CreateObject("Scripting.FileSystemObject");
 7bookPath = fso.GetAbsolutePathName("Book1.xlsx");
 8if (fso.FileExists(bookPath))  fso.DeleteFile(bookPath);
 9srcPath = fso.GetAbsolutePathName("pt_source02.xls");
10exlApp = WScript.CreateObject("Excel.Application");  // Excelの起動
11exlApp.Visible = true;  // Excelを見える状態に
12exlApp.Workbooks.Open(srcPath);
13ws = exlApp.ActiveWorkbook.WorkSheets(1);
14areaName = "[pt_source02.xls]" + ws.Name + "!" + ws.UsedRange.Address
15wb = exlApp.Workbooks.Add();  // Workbookの新規作成
16wb.WorkSheets(1).Activate();
17
18ptCache = wb.PivotCaches().Create(xlDatabase, areaName);
19ptObj = ptCache.CreatePivotTable(
20    "R1C1", "ピボット01");
21
22with (ptObj.PivotFields("商品")) {
23    Orientation = xlColumnField;
24    LabelRange.Value = "商品";
25    vAry = ["調味料", "飲料", "乳製品", "魚介類"];
26    for(i=0; i<vAry.length; i++) {
27        PivotItems(vAry[i]).Position = i+1;
28    }
29    exlApp.Union(PivotItems(1).LabelRange,
30        PivotItems(2).LabelRange).Group;
31    exlApp.Union(PivotItems(3).LabelRange,
32        PivotItems(4).LabelRange).Group;
33    with (ParentField) {
34        PivotItems(1).Name = "種別Ａ";
35        PivotItems(2).Name = "種別Ｂ";
36        Subtotals(1) = true;
37    }
38}
39with (ptObj.PivotFields("売上")) {
40    Orientation = xlDataField;
41    Function = xlSum;  // 合計の算出
42    Caption = "売上・計";
43    NumberFormat = "#,##0";
44}
45with (ptObj.PivotFields("仕入原価")) {
46    Orientation = xlDataField;
47    Function = xlSum;
48    Caption = "仕入原価・計";
49    NumberFormat = "#,##0";
50}
51ptObj.DataPivotField.Orientation = xlRowField;
52ptObj.DataPivotField.Name = "合計値";
53wb.SaveAs(bookPath, xlOpenXMLWorkbook);
54exlApp.Quit();
55
56function ReadFile(filename) {
57    var fso = WScript.CreateObject("Scripting.FileSystemObject");
58    var path = fso.GetAbsolutePathName(filename);
59    var MyStr = null;
60    if (fso.FileExists(path)) {
61        var fobj = fso.OpenTextFile(path, 1);
62        MyStr = fobj.ReadAll();
63        fobj.Close();
64    }
65    return MyStr;
66}

〜　以上　〜