グループ化の処理とページフィールド

　その第２弾「グループ化の処理とページフィールド」です。

《このページの目次》

1.　VBAマクロ

 1Option Base 1  ' 配列の添え字を 1 から始める
 2Sub Macro1()
 3    Dim pName As String, bName As String
 4    Dim ws As WorkSheet, rngName As String
 5    Dim ptCache As PivotCache, ptObj As PivotTable
 6    Dim argAry(7) As Boolean, i As Integer, iNames As Variant
 7　　　　
 8    pName = ThisWorkbook.Path  ' 本ワークブックのフォルダ名
 9    bName = ThisWorkbook.Name  ' 本ワークブックの名前
10    Workbooks.Open pName & "\pt_source02.xls"  ' ソースデータを開く
11    Set ws = WorkSheets(1)
12    rngName = "[pt_source02.xls]" & ws.Name & "!" & ws.UsedRange.Address
13    Workbooks(bName).Activate  ' 本ワークブックをアクティブに
14    WorkSheets(1).Activate  ' 第１シートをアクティブに
15　　　　
16    Set ptCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
17        SourceData:=rngName)
18    Set ptObj = ptCache.CreatePivotTable( _
19        TableDestination:="R1C1", TableName:="BasePivot")
20　　　　
21    For i = 1 To 7
22        argAry(i) = False
23    Next
24    argAry(6) = True  ' 6番目の要素をtrueに。四半期単位の指定
25    With ptObj.PivotFields("日付")
26        .Orientation = xlColumnField
27        .DataRange.Cells(1).Group Periods:=argAry
28        For i = 1 To .PivotItems.Count
29            If .PivotItems(i).RecordCount = 0 Then
30                .PivotItems(i).Name = "!Item" & .PivotItems(i).Position
31                .PivotItems(i).Visible = False
32            End If
33        Next
34        .Orientation = xlPageField
35        .LabelRange.Value = "期間区分"
36    End With
37    iNames = Array("調味料", "飲料", "乳製品", "魚介類")
38    With ptObj.PivotFields("商品")
39        .Orientation = xlRowField
40        .LabelRange.Value = .Name
41        For i = LBound(iNames) To UBound(iNames)
42            .PivotItems(iNames(i)).Position = i
43        Next
44    End With
45    SetDataFld ptObj.PivotFields("売上"), xlSum, "売上(a)", "#,##0"
46    SetDataFld ptObj.PivotFields("仕入原価"), xlSum, "仕入原価(b)", "#,##0"
47    SetDataFld ptObj.CalculatedFields.Add("利益", "=売上 - 仕入原価"),, _
48        "利益(c:a-b)", "#,##0"
49    SetDataFld ptObj.CalculatedFields.Add("利益率", "=利益 / 売上"),, _
50        "利益率(d:c/a)", "0.0%"
51    ptObj.ShowPages  ' ページフィールドの全アイテム表示
52End Sub
53　　　　
54Sub SetDataFld(ByRef ptFld As PivotField, Optional ByVal funcVal, _
55        Optional ByVal capName, Optional ByVal numFmt)
56    With ptFld
57        .Orientation = xlDataField
58        If Not IsMissing(funcVal) Then  .Function = funcVal
59        If Not IsMissing(capName) Then  .Caption = capName
60        If Not IsMissing(numFmt) Then  .NumberFormat = numFmt
61    End With
62End Sub

2.　VBScript

 1Option Explicit
 2Dim fso, bookPath, srcPath
 3Dim exlApp, wbObj, ws, rngName
 4Dim ptCache, ptObj
 5Dim argAry(6), i, iNames
 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)
16rngName = "[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, rngName)
21Set ptObj = ptCache.CreatePivotTable( _
22    "R1C1", "BasePivot")
23　　　　
24For i = 0 To 6
25    argAry(i) = False
26Next
27argAry(5) = True  ' 6番目の要素をtrueに。四半期単位の指定
28With ptObj.PivotFields("日付")
29    .Orientation = xlColumnField
30    .DataRange.Cells(1).Group ,,,argAry
31    For i = 1 To .PivotItems.Count
32        If .PivotItems(i).RecordCount = 0 Then
33            .PivotItems(i).Name = "!Item" & .PivotItems(i).Position
34            .PivotItems(i).Visible = False
35        End If
36    Next
37    .Orientation = xlPageField
38    .LabelRange.Value = "期間区分"
39End With
40iNames = Array("調味料", "飲料", "乳製品", "魚介類")
41With ptObj.PivotFields("商品")
42    .Orientation = xlRowField
43    .LabelRange.Value = .Name
44    For i = LBound(iNames) To UBound(iNames)
45        .PivotItems(iNames(i)).Position = i + 1
46    Next
47End With
48SetDataFld ptObj.PivotFields("売上"), xlSum, "売上(a)", "#,##0"
49SetDataFld ptObj.PivotFields("仕入原価"), xlSum, "仕入原価(b)", "#,##0"
50SetDataFld ptObj.CalculatedFields.Add("利益", "=売上 - 仕入原価"),, _
51    "利益(c:a-b)", "#,##0"
52SetDataFld ptObj.CalculatedFields.Add("利益率", "=利益 / 売上"),, _
53    "利益率(d:c/a)", "0.0%"
54ptObj.ShowPages  ' ページフィールドの全アイテム表示
55wbObj.SaveAs bookPath, xlOpenXMLWorkbook
56exlApp.quit
57　　　　
58Sub SetDataFld(ByRef ptFld, ByVal funcVal, ByVal capName, ByVal numFmt)
59    With ptFld
60        .Orientation = xlDataField
61        If Not IsMissing(funcVal) Then  .Function = funcVal
62        If Not IsMissing(capName) Then  .Caption = capName
63        If Not IsNull(numFmt) Then .NumberFormat = numFmt
64    End With
65End Sub
66　　　　
67Function IsMissing(p)
68    IsMissing = (VarType(p) = vbError)
69End Function
70　　　　
71Sub Include(ByVal FileName)
72    Dim fso, FileObj, MyStr
73    Set fso = CreateObject("Scripting.FileSystemObject") 
74    Set FileObj = fso.OpenTextFile(fso.GetAbsolutePathName(FileName))
75    MyStr = FileObj.ReadAll()
76    FileObj.Close
77    Set fso = Nothing
78    Set FileObj = Nothing
79    ExecuteGlobal MyStr
80End Sub

3.　JScript

 1var fso, bookPath, srcPath;
 2var exlApp, wb, ws, rngName;
 3var ptCache, ptObj, argAry, i;
 4var iNames = new Array("調味料", "飲料", "乳製品", "魚介類");
 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_source02.xls");
11exlApp = WScript.CreateObject("Excel.Application");  // Excelの起動
12exlApp.Visible = true;  // Excelを見える状態に
13exlApp.Workbooks.Open(srcPath);
14ws = exlApp.ActiveWorkbook.WorkSheets(1);
15rngName = "[pt_source02.xls]" + ws.Name + "!" + ws.UsedRange.Address
16wb = exlApp.Workbooks.Add();  // Workbookの新規作成
17wb.WorkSheets(1).Activate();
18　　　　
19ptCache = wb.PivotCaches().Create(xlDatabase, rngName);
20ptObj = ptCache.CreatePivotTable(
21    "R1C1", "BasePivot");
22　　　　
23argAry = WScript.CreateObject("System.Collections.ArrayList");
24for(i=0; i<=6; i++) {
25    argAry.add(false);
26}
27argAry(5) = true;  // 6番目の要素をtrueに。四半期単位の指定
28with (ptObj.PivotFields("日付")) {
29    Orientation = xlColumnField;
30    DataRange.Cells(1).Group(null, null, null, argAry.ToArray());
31    for(i = 1; i <= PivotItems.Count; i++) {
32        if (PivotItems(i).RecordCount === 0) {
33            PivotItems(i).Name = "!Item" + PivotItems(i).Position;
34            PivotItems(i).Visible = false;
35        }
36    }
37    Orientation = xlPageField;
38    LabelRange.Value = "期間区分";
39}
40with (ptObj.PivotFields("商品")) {
41    Orientation = xlRowField;
42    LabelRange.Value = Name
43    for(i=0; i<iNames.length; i++) {
44        PivotItems(iNames[i]).Position = i + 1;
45    }
46}
47SetDataFld(ptObj.PivotFields("売上"), xlSum, "売上(a)", "#,##0");
48SetDataFld(ptObj.PivotFields("仕入原価"), xlSum, "仕入原価(b)", "#,##0");
49SetDataFld(ptObj.CalculatedFields().Add("利益", "=売上 - 仕入原価"), null,
50    "利益(c:a-b)", "#,##0");
51SetDataFld(ptObj.CalculatedFields().Add("利益率", "=利益 / 売上"), null,
52    "利益率(d:c/a)", "0.0%");
53ptObj.ShowPages();  // ページフィールドの全アイテム表示
54wb.SaveAs(bookPath, xlOpenXMLWorkbook);
55exlApp.Quit();
56　　　　
57function SetDataFld(ptFld, funcVal, capName, numFmt) {
58    with (ptFld) {
59        Orientation = xlDataField
60        if (funcVal !== null) Function = funcVal;
61        if (capName !== null) Caption = capName;
62        if (numFmt !== null) NumberFormat = numFmt;
63    }
64}
65　　　　
66function ReadFile(filename) {
67    var fso = WScript.CreateObject("Scripting.FileSystemObject");
68    var path = fso.GetAbsolutePathName(filename);
69    var MyStr = null;
70    if (fso.FileExists(path)) {
71        var fobj = fso.OpenTextFile(path, 1);
72        MyStr = fobj.ReadAll();
73        fobj.Close();
74    }
75    return MyStr;
76}

グループ化の処理とページフィールド

《このページの目次》

1. VBAマクロ

2. VBScript

3. JScript

1.　VBAマクロ

2.　VBScript

3.　JScript