ページフィールドの設定・基本形

 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    iNames = Array("調味料", "飲料", "乳製品", "魚介類")
22    With ptObj.PivotFields("商品")
23        .Orientation = xlPageField
24        For i = LBound(iNames) To UBound(iNames)
25            .PivotItems(iNames(i)).Position = i
26        Next
27    End With
28    For i = 1 To 7
29        argAry(i) = False
30    Next
31    argAry(6) = True  ' 6番目の要素をtrueに。四半期単位の指定
32    With ptObj.PivotFields("日付")
33        .Orientation = xlRowField
34        .LabelRange.Value = "期間区分"
35        .DataRange.Cells(1).Group Periods:=argAry
36    End With
37    SetDataFld ptObj.PivotFields("売上"), xlSum, "売上(a)", "#,##0"
38    SetDataFld ptObj.PivotFields("仕入原価"), xlSum, "仕入原価(b)", "#,##0"
39    SetDataFld ptObj.CalculatedFields.Add("利益", "=売上 - 仕入原価"),, _
40        "利益(c:a-b)", "#,##0"
41    SetDataFld ptObj.CalculatedFields.Add("利益率", "=利益 / 売上"),, _
42        "利益率(d:c/a)", "0.0%"
43    ptObj.ShowPages  ' ページフィールドの全アイテム表示
44End Sub
45　　　　
46Sub SetDataFld(ByRef ptFld As PivotField, Optional ByVal funcVal, _
47        Optional ByVal capName, Optional ByVal numFmt)
48    With ptFld
49        .Orientation = xlDataField
50        If Not IsMissing(funcVal) Then  .Function = funcVal
51        If Not IsMissing(capName) Then  .Caption = capName
52        If Not IsMissing(numFmt) Then  .NumberFormat = numFmt
53    End With
54End 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　　　　
24iNames = Array("調味料", "飲料", "乳製品", "魚介類")
25With ptObj.PivotFields("商品")
26    .Orientation = xlPageField
27    For i = LBound(iNames) To UBound(iNames)
28        .PivotItems(iNames(i)).Position = i + 1
29    Next
30End With
31For i = 0 To 6
32    argAry(i) = False
33Next
34argAry(5) = True  ' 6番目の要素をtrueに。四半期単位の指定
35With ptObj.PivotFields("日付")
36    .Orientation = xlRowField
37    .LabelRange.Value = "期間区分"
38    .DataRange.Cells(1).Group ,,,argAry
39End With
40SetDataFld ptObj.PivotFields("売上"), xlSum, "売上(a)", "#,##0"
41SetDataFld ptObj.PivotFields("仕入原価"), xlSum, "仕入原価(b)", "#,##0"
42SetDataFld ptObj.CalculatedFields.Add("利益", "=売上 - 仕入原価"),, _
43    "利益(c:a-b)", "#,##0"
44SetDataFld ptObj.CalculatedFields.Add("利益率", "=利益 / 売上"),, _
45    "利益率(d:c/a)", "0.0%"
46ptObj.ShowPages  ' ページフィールドの全アイテム表示
47wbObj.SaveAs bookPath, xlOpenXMLWorkbook
48exlApp.quit
49　　　　
50Sub SetDataFld(ByRef ptFld, ByVal funcVal, ByVal capName, ByVal numFmt)
51    With ptFld
52        .Orientation = xlDataField
53        If Not IsMissing(funcVal) Then  .Function = funcVal
54        If Not IsMissing(capName) Then  .Caption = capName
55        If Not IsNull(numFmt) Then .NumberFormat = numFmt
56    End With
57End Sub
58　　　　
59Function IsMissing(p)
60    IsMissing = (VarType(p) = vbError)
61End Function
62　　　　
63Sub Include(ByVal FileName)
64    Dim fso, FileObj, MyStr
65    Set fso = CreateObject("Scripting.FileSystemObject") 
66    Set FileObj = fso.OpenTextFile(fso.GetAbsolutePathName(FileName))
67    MyStr = FileObj.ReadAll()
68    FileObj.Close
69    Set fso = Nothing
70    Set FileObj = Nothing
71    ExecuteGlobal MyStr
72End 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　　　　
23with (ptObj.PivotFields("商品")) {
24    Orientation = xlPageField;
25    for(i=0; i<iNames.length; i++) {
26        PivotItems(iNames[i]).Position = i + 1;
27    }
28}
29argAry = WScript.CreateObject("System.Collections.ArrayList");
30for(i=0; i<=6; i++) {
31    argAry.add(false);
32}
33argAry(5) = true;  // 6番目の要素をtrueに。四半期単位の指定
34with (ptObj.PivotFields("日付")) {
35    Orientation = xlRowField;
36    LabelRange.Value = "期間区分";
37    DataRange.Cells(1).Group(null, null, null, argAry.ToArray());
38}
39SetDataFld(ptObj.PivotFields("売上"), xlSum, "売上(a)", "#,##0");
40SetDataFld(ptObj.PivotFields("仕入原価"), xlSum, "仕入原価(b)", "#,##0");
41SetDataFld(ptObj.CalculatedFields().Add("利益", "=売上 - 仕入原価"), null,
42    "利益(c:a-b)", "#,##0");
43SetDataFld(ptObj.CalculatedFields().Add("利益率", "=利益 / 売上"), null,
44    "利益率(d:c/a)", "0.0%");
45ptObj.ShowPages();  // ページフィールドの全アイテム表示
46wb.SaveAs(bookPath, xlOpenXMLWorkbook);
47exlApp.Quit();
48　　　　
49function SetDataFld(ptFld, funcVal, capName, numFmt) {
50    with (ptFld) {
51        Orientation = xlDataField
52        if (funcVal !== null) Function = funcVal;
53        if (capName !== null) Caption = capName;
54        if (numFmt !== null) NumberFormat = numFmt;
55    }
56}
57　　　　
58function ReadFile(filename) {
59    var fso = WScript.CreateObject("Scripting.FileSystemObject");
60    var path = fso.GetAbsolutePathName(filename);
61    var MyStr = null;
62    if (fso.FileExists(path)) {
63        var fobj = fso.OpenTextFile(path, 1);
64        MyStr = fobj.ReadAll();
65        fobj.Close();
66    }
67    return MyStr;
68}

ページフィールドの設定・基本形

《このページの目次》

1.　VBAマクロ

2.　VBScript

3.　JScript

ページフィールドの設定・基本形

《このページの目次》

1. VBAマクロ

2. VBScript

3. JScript

1.　VBAマクロ

2.　VBScript

3.　JScript