列範囲のグループ化による日付の処理

2017/09/02

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

　その第２弾「列範囲のグループ化による日付の処理」です。

　　　　

《このページの目次》

　　　　

1.　VBAマクロ

　半年単位のグループ化、各月二分類のグループ化(15日までと16日以降)があります。

(1)　半年単位のグループ化

 1Option Explicit
 2Sub Macro1()
 3    Dim pName As String, bName As String
 4    Dim ws As WorkSheet, areaName As String
 5    Dim ptCache As PivotCache, ptObj As PivotTable
 6    Dim addrAry, nameAry, vAry
 7    Dim itmRng As Range, nameNow As String, nameOld As String
 8    Dim monthVal As Integer, i As Integer
 9
10    pName = ThisWorkbook.Path  ' 本ワークブックのフォルダ名
11    bName = ThisWorkbook.Name  ' 本ワークブックの名前
12    Workbooks.Open pName & "\pt_source02.xls"  ' ソースデータを開く
13    Set ws = WorkSheets(1)
14    areaName = "[pt_source02.xls]" & ws.Name & "!" & ws.UsedRange.Address
15    Workbooks(bName).Activate  ' 本ワークブックをアクティブに
16    WorkSheets(1).Activate  ' 第１シートをアクティブに
17
18    Set ptCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
19        SourceData:=areaName)
20    Set ptObj = ptCache.CreatePivotTable( _
21        TableDestination:="R1C1", TableName:="ピボット01")
22
23    Set addrAry = CreateObject("System.Collections.ArrayList")
24    Set nameAry = CreateObject("System.Collections.ArrayList")
25    With ptObj.PivotFields("日付")
26        .Orientation = xlColumnField
27        .LabelRange.Value = "期間区分"
28        For i = 1 To .PivotItems.Count
29            Set itmRng = .PivotItems(i).LabelRange
30            vAry = Split(.PivotItems(i).Name, "/")
31            monthVal = CInt(vAry(0))
32            If monthVal < 7 Then nameNow = vAry(2) & "上半期" _
33            Else nameNow = vAry(2) & "下半期"
34            If i = 1 Then
35                addrAry.Add(itmRng.Address)  ' 始点を記録
36                nameAry.Add(nameNow)
37                nameOld = nameNow
38            ElseIf nameNow <> nameOld Then
39                addrAry(addrAry.Count-1) = addrAry(addrAry.Count-1) & _
40                    ":" & .PivotItems(i-1).LabelRange.Address  ' 終点を記録
41                addrAry.Add(itmRng.Address)  ' 始点を記録
42                nameAry.Add(nameNow)
43                nameOld = nameNow
44            End If
45            If i = .PivotItems.Count Then
46                addrAry(addrAry.Count-1) = addrAry(addrAry.Count-1) & _
47                    ":" & itmRng.Address  ' 終点を記録
48            End If
49        Next
50        If addrAry.Count > 1 Then  ' グループが２以上ある
51            For i = 0 To addrAry.Count-1
52                Range(addrAry(i)).Group
53            Next
54            For i = 0 To nameAry.Count-1
55                .ParentField.PivotItems(i+1).Name = nameAry(i)
56            Next
57            .Orientation = xlHidden
58        End If
59    End With
60    With ptObj.PivotFields("売上")
61        .Orientation = xlDataField
62        .Function = xlSum  ' 合計を算出
63        .Caption = "売上・計"
64        .NumberFormat = "#,##0"
65    End With
66    With ptObj.PivotFields("仕入原価")
67        .Orientation = xlDataField
68        .Function = xlSum
69        .Caption = "仕入原価・計"
70        .NumberFormat = "#,##0"
71    End With
72    ptObj.DataPivotField.Orientation = xlRowField
73    ptObj.DataPivotField.Name = "合計値"
74End Sub

目次に戻る

(2)　各月二分類のグループ化

 1Option Explicit
 2Sub Macro1()
 3    Dim pName As String, bName As String
 4    Dim ws As WorkSheet, areaName As String
 5    Dim ptCache As PivotCache, ptObj As PivotTable
 6    Dim addrHash, keys, vAry
 7    Dim itmRng As Range, nameNow As String, nameOld As String
 8    Dim dayVal As Integer, i As Integer
 9
10    pName = ThisWorkbook.Path  ' 本ワークブックのフォルダ名
11    bName = ThisWorkbook.Name  ' 本ワークブックの名前
12    Workbooks.Open pName & "\pt_source02.xls"  ' ソースデータを開く
13    Set ws = WorkSheets(1)
14    areaName = "[pt_source02.xls]" & ws.Name & "!" & ws.UsedRange.Address
15    Workbooks(bName).Activate  ' 本ワークブックをアクティブに
16    WorkSheets(1).Activate  ' 第１シートをアクティブに
17
18    Set ptCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
19        SourceData:=areaName)
20    Set ptObj = ptCache.CreatePivotTable( _
21        TableDestination:="R1C1", TableName:="ピボット01")
22
23    Set addrHash = CreateObject("Scripting.Dictionary")
24    With ptObj.PivotFields("日付")
25        .Orientation = xlColumnField
26        For i = 1 To .PivotItems.Count
27            Set itmRng = .PivotItems(i).LabelRange
28            vAry = Split(.PivotItems(i).Name, "/")
29            dayVal = CInt(vAry(1))
30            If dayVal < 16 Then nameNow = vAry(0) & "月上期" _
31            Else nameNow = vAry(0) & "月下期"
32            If i = 1 Then
33                addrHash.Add nameNow, itmRng.Address  ' 始点を記録
34                nameOld = nameNow
35            ElseIf nameNow <> nameOld Then
36                addrHash(nameOld) = addrHash(nameOld) & _
37                    ":" & .PivotItems(i-1).LabelRange.Address  ' 終点を記録
38                addrHash.Add nameNow, itmRng.Address  ' 始点を記録
39                nameOld = nameNow
40            End If
41            If i = .PivotItems.Count Then
42                addrHash(nameNow) = addrHash(nameNow) & _
43                    ":" & itmRng.Address  ' 終点を記録
44            End If
45        Next
46        keys = addrHash.keys
47        If UBound(keys) > 1 Then  ' グループが２以上ある
48            For i = LBound(keys) To UBound(keys)
49                Range(addrHash(keys(i))).Group
50            Next
51            For i = LBound(keys) To UBound(keys)
52                .ParentField.PivotItems(i+1).Name = keys(i)
53            Next
54            .ParentField.Orientation = xlRowField
55            .ParentField.LabelRange.Value = "期間区分"
56            .Orientation = xlHidden
57        End If
58    End With
59    With ptObj.PivotFields("売上")
60        .Orientation = xlDataField
61        .Function = xlSum  ' 合計を算出
62        .Caption = "売上・計"
63        .NumberFormat = "#,##0"
64    End With
65    With ptObj.PivotFields("仕入原価")
66        .Orientation = xlDataField
67        .Function = xlSum
68        .Caption = "仕入原価・計"
69        .NumberFormat = "#,##0"
70    End With
71    ptObj.DataPivotField.Name = "合計値"
72End Sub

目次に戻る

2.　VBScript

　半年単位のグループ化、各月二分類のグループ化(15日までと16日以降)があります。

(1)　半年単位のグループ化

 1Option Explicit
 2Dim fso, bookPath, srcPath
 3Dim exlApp, wbObj, ws, areaName
 4Dim ptCache, ptObj
 5Dim addrAry, nameAry, itmRng
 6Dim vAry, i, monthVal
 7Dim nameOld, nameNow
 8Include "constants_xl.vbs"
 9
10Set fso = CreateObject("Scripting.FileSystemObject")
11bookPath = fso.GetAbsolutePathName("Book1.xlsx")
12If (fso.FileExists(bookPath) = True) Then fso.DeleteFile(bookPath)
13srcPath = fso.GetAbsolutePathName("pt_source02.xls")
14Set exlApp = CreateObject("Excel.Application")  ' Excelの起動
15exlApp.Visible = True  ' Excelを見える状態に
16exlApp.Workbooks.Open srcPath
17Set ws = exlApp.ActiveWorkbook.WorkSheets(1)
18areaName = "[pt_source02.xls]" & ws.Name & "!" & ws.UsedRange.Address
19Set wbObj = exlApp.Workbooks.Add()  ' Workbookの新規作成
20Set ws = wbObj.WorkSheets(1)
21ws.Activate
22
23Set ptCache = wbObj.PivotCaches.Create(xlDatabase, areaName)
24Set ptObj = ptCache.CreatePivotTable( _
25    "R1C1", "ピボット01")
26
27Set addrAry = WScript.CreateObject("System.Collections.ArrayList")
28Set nameAry = WScript.CreateObject("System.Collections.ArrayList")
29With ptObj.PivotFields("日付")
30    .Orientation = xlColumnField
31    .LabelRange.Value = "期間区分"
32    For i = 1 To .PivotItems.Count
33        Set itmRng = .PivotItems(i).LabelRange
34        vAry = Split(.PivotItems(i).Name, "/")
35        monthVal = CInt(vAry(0))
36        If monthVal < 7 Then nameNow = vAry(2) & "上半期" _
37        Else nameNow = vAry(2) & "下半期"
38        If i = 1 Then
39            addrAry.Add(itmRng.Address)  ' 始点を記録
40            nameAry.Add(nameNow)
41            nameOld = nameNow
42        ElseIf nameNow <> nameOld Then
43            addrAry(addrAry.Count-1) = addrAry(addrAry.Count-1) & _
44                ":" & .PivotItems(i-1).LabelRange.Address  ' 終点を記録
45            addrAry.Add(itmRng.Address)  ' 始点を記録
46            nameAry.Add(nameNow)
47            nameOld = nameNow
48        End If
49        If i = .PivotItems.Count Then
50            addrAry(addrAry.Count-1) = addrAry(addrAry.Count-1) & _
51                ":" & itmRng.Address  ' 終点を記録
52        End If
53    Next
54    If addrAry.Count > 1 Then  ' グループが２以上ある
55        For i = 0 To addrAry.Count-1
56            ws.Range(addrAry(i)).Group
57        Next
58        For i = 0 To nameAry.Count-1
59            .ParentField.PivotItems(i+1).Name = nameAry(i)
60        Next
61        .Orientation = xlHidden
62    End If
63End With
64With ptObj.PivotFields("売上")
65    .Orientation = xlDataField
66    .Function = xlSum  ' 合計の算出
67    .Caption = "売上・計"
68    .NumberFormat = "#,##0"
69End With
70With ptObj.PivotFields("仕入原価")
71    .Orientation = xlDataField
72    .Function = xlSum
73    .Caption = "仕入原価・計"
74    .NumberFormat = "#,##0"
75End With
76ptObj.DataPivotField.Orientation = xlRowField
77ptObj.DataPivotField.Name = "合計値"
78wbObj.SaveAs bookPath, xlOpenXMLWorkbook
79exlApp.quit
80
81Sub Include(ByVal FileName)
82    Dim fso, FileObj, MyStr
83    Set fso = CreateObject("Scripting.FileSystemObject") 
84    Set FileObj = fso.OpenTextFile(fso.GetAbsolutePathName(FileName))
85    MyStr = FileObj.ReadAll()
86    FileObj.Close
87    Set fso = Nothing
88    Set FileObj = Nothing
89    ExecuteGlobal MyStr
90End Sub

目次に戻る

(2)　各月二分類のグループ化

 1Option Explicit
 2Dim fso, bookPath, srcPath
 3Dim exlApp, wbObj, ws, areaName
 4Dim ptCache, ptObj
 5Dim addrHash, keys, itmRng
 6Dim vAry, i, dayVal
 7Dim nameOld, nameNow
 8Include "constants_xl.vbs"
 9
10Set fso = CreateObject("Scripting.FileSystemObject")
11bookPath = fso.GetAbsolutePathName("Book1.xlsx")
12If (fso.FileExists(bookPath) = True) Then fso.DeleteFile(bookPath)
13srcPath = fso.GetAbsolutePathName("pt_source02.xls")
14Set exlApp = CreateObject("Excel.Application")  ' Excelの起動
15exlApp.Visible = True  ' Excelを見える状態に
16exlApp.Workbooks.Open srcPath
17Set ws = exlApp.ActiveWorkbook.WorkSheets(1)
18areaName = "[pt_source02.xls]" & ws.Name & "!" & ws.UsedRange.Address
19Set wbObj = exlApp.Workbooks.Add()  ' Workbookの新規作成
20Set ws = wbObj.WorkSheets(1)
21ws.Activate
22
23Set ptCache = wbObj.PivotCaches.Create(xlDatabase, areaName)
24Set ptObj = ptCache.CreatePivotTable( _
25    "R1C1", "ピボット01")
26
27Set addrHash = WScript.CreateObject("Scripting.Dictionary")
28With ptObj.PivotFields("日付")
29    .Orientation = xlColumnField
30    For i = 1 To .PivotItems.Count
31        Set itmRng = .PivotItems(i).LabelRange
32        vAry = Split(.PivotItems(i).Name, "/")
33        dayVal = CInt(vAry(1))
34        If dayVal < 16 Then nameNow = vAry(0) & "月上期" _
35        Else nameNow = vAry(0) & "月下期"
36        If i = 1 Then
37            addrHash.Add nameNow, itmRng.Address  ' 始点を記録
38            nameOld = nameNow
39        ElseIf nameNow <> nameOld Then
40            addrHash(nameOld) = addrHash(nameOld) & _
41                ":" & .PivotItems(i-1).LabelRange.Address  ' 終点を記録
42            addrHash.Add nameNow, itmRng.Address  ' 始点を記録
43            nameOld = nameNow
44        End If
45        If i = .PivotItems.Count Then
46            addrHash(nameNow) = addrHash(nameNow) & _
47                ":" & itmRng.Address  ' 終点を記録
48        End If
49    Next
50    keys = addrHash.keys
51    If UBound(keys) > 1 Then  ' グループが２以上ある
52        For i = LBound(keys) To UBound(keys)
53            ws.Range(addrHash(keys(i))).Group
54        Next
55        For i = LBound(keys) To UBound(keys)
56            .ParentField.PivotItems(i+1).Name = keys(i)
57        Next
58        .ParentField.Orientation = xlRowField
59        .ParentField.LabelRange.Value = "期間区分"
60        .Orientation = xlHidden
61    End If
62End With
63With ptObj.PivotFields("売上")
64    .Orientation = xlDataField
65    .Function = xlSum  ' 合計の算出
66    .Caption = "売上・計"
67    .NumberFormat = "#,##0"
68End With
69With ptObj.PivotFields("仕入原価")
70    .Orientation = xlDataField
71    .Function = xlSum
72    .Caption = "仕入原価・計"
73    .NumberFormat = "#,##0"
74End With
75ptObj.DataPivotField.Name = "合計値"
76wbObj.SaveAs bookPath, xlOpenXMLWorkbook
77exlApp.quit
78
79Sub Include(ByVal FileName)
80    Dim fso, FileObj, MyStr
81    Set fso = CreateObject("Scripting.FileSystemObject") 
82    Set FileObj = fso.OpenTextFile(fso.GetAbsolutePathName(FileName))
83    MyStr = FileObj.ReadAll()
84    FileObj.Close
85    Set fso = Nothing
86    Set FileObj = Nothing
87    ExecuteGlobal MyStr
88End Sub

目次に戻る

3.　JScript(ArrayList, Scripting.Dictionary を利用)

　半年単位のグループ化、各月二分類のグループ化(15日までと16日以降)があります。

　VBScriptと同様、配列に ArrayList、hashに Scripting.Dictionary を利用。

(1)　半年単位のグループ化

 1var fso, bookPath, srcPath;
 2var exlApp, wb, ws, areaName;
 3var ptCache, ptObj;
 4var addrAry, nameAry, monthVal, vAry, i;
 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);
15areaName = "[pt_source02.xls]" + ws.Name + "!" + ws.UsedRange.Address
16wb = exlApp.Workbooks.Add();  // Workbookの新規作成
17ws = wb.WorkSheets(1)
18ws.Activate;
19
20ptCache = wb.PivotCaches().Create(xlDatabase, areaName);
21ptObj = ptCache.CreatePivotTable(
22    "R1C1", "ピボット01");
23
24addrAry = WScript.CreateObject("System.Collections.ArrayList");
25nameAry = WScript.CreateObject("System.Collections.ArrayList");
26with (ptObj.PivotFields("日付")) {
27    Orientation = xlColumnField;
28    LabelRange.Value = "期間区分";
29    for(i = 1; i <= PivotItems.Count; i++) {
30        itmRng = PivotItems(i).LabelRange;
31        vAry = PivotItems(i).Name.split('/');
32        monthVal = parseInt(vAry[0]);
33        nameNow = (monthVal < 7) ? vAry[2] + "上半期" :
34            vAry[2] + "下半期";
35        if (i === 1) {
36            addrAry.Add(itmRng.Address);  // 始点を記録
37            nameAry.Add(nameNow);
38            nameOld = nameNow;
39        } else if (nameNow !== nameOld) {
40            addrAry(addrAry.Count-1) = addrAry(addrAry.Count-1) +
41                ":" + PivotItems(i-1).LabelRange.Address;  // 終点を記録
42            addrAry.Add(itmRng.Address);  // 始点を記録
43            nameAry.Add(nameNow);
44            nameOld = nameNow;
45        }
46        if (i === PivotItems.Count) {
47            addrAry(addrAry.Count-1) = addrAry(addrAry.Count-1) +
48                ":" + itmRng.Address;  // 終点を記録
49        }
50    }
51    if (addrAry.Count > 1) {  // グループが２以上ある
52        for(i = 0; i < addrAry.Count; i++) {
53            ws.Range(addrAry(i)).Group;
54        }
55        for(i = 0; i < nameAry.Count; i++) {
56            ParentField.PivotItems(i+1).Name = nameAry(i);
57        }
58        Orientation = xlHidden;
59    }
60}
61with (ptObj.PivotFields("売上")) {
62    Orientation = xlDataField;
63    Function = xlSum;  // 合計の算出
64    Caption = "売上・計";
65    NumberFormat = "#,##0";
66}
67with (ptObj.PivotFields("仕入原価")) {
68    Orientation = xlDataField;
69    Function = xlSum;
70    Caption = "仕入原価・計";
71    NumberFormat = "#,##0";
72}
73ptObj.DataPivotField.Orientation = xlRowField;
74ptObj.DataPivotField.Name = "合計値";
75wb.SaveAs(bookPath, xlOpenXMLWorkbook);
76exlApp.Quit();
77
78function ReadFile(filename) {
79    var fso = WScript.CreateObject("Scripting.FileSystemObject");
80    var path = fso.GetAbsolutePathName(filename);
81    var MyStr = null;
82    if (fso.FileExists(path)) {
83        var fobj = fso.OpenTextFile(path, 1);
84        MyStr = fobj.ReadAll();
85        fobj.Close();
86    }
87    return MyStr;
88}

目次に戻る

(2)　各月二分類のグループ化

 1var fso, bookPath, srcPath;
 2var exlApp, wb, ws, areaName;
 3var ptCache, ptObj;
 4var addrHash, keys, dayVal, vAry, i;
 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);
15areaName = "[pt_source02.xls]" + ws.Name + "!" + ws.UsedRange.Address
16wb = exlApp.Workbooks.Add();  // Workbookの新規作成
17ws = wb.WorkSheets(1)
18ws.Activate;
19
20ptCache = wb.PivotCaches().Create(xlDatabase, areaName);
21ptObj = ptCache.CreatePivotTable(
22    "R1C1", "ピボット01");
23
24addrHash = WScript.CreateObject("Scripting.Dictionary");
25with (ptObj.PivotFields("日付")) {
26    Orientation = xlColumnField;
27    LabelRange.Value = "期間区分";
28    for(i = 1; i <= PivotItems.Count; i++) {
29        itmRng = PivotItems(i).LabelRange;
30        vAry = PivotItems(i).Name.split('/');
31        dayVal = parseInt(vAry[1]);
32        nameNow = (dayVal < 16) ? vAry[0] + "月上期" :
33            vAry[0] + "月下期";
34        if (i === 1) {
35            addrHash.Add(nameNow, itmRng.Address);  // 始点を記録
36            nameOld = nameNow;
37        } else if (nameNow !== nameOld) {
38            addrHash(nameOld) = addrHash(nameOld) +
39                ":" + PivotItems(i-1).LabelRange.Address;  // 終点を記録
40            addrHash.Add(nameNow, itmRng.Address);  // 始点を記録
41            nameOld = nameNow;
42        }
43        if (i === PivotItems.Count) {
44            addrHash(nameNow) = addrHash(nameNow) +
45                ":" + itmRng.Address;  // 終点を記録
46        }
47    }
48    keys = (new VBArray(addrHash.Keys())).toArray();
49    if (keys.length > 1) {  // グループが２以上ある
50        for(i = 0; i < keys.length; i++) {
51            ws.Range(addrHash(keys[i])).Group;
52        }
53        for(i = 0; i < keys.length; i++) {
54            ParentField.PivotItems(i+1).Name = keys[i];
55        }
56        ParentField.Orientation = xlRowField;
57        ParentField.LabelRange.Value = "期間区分";
58        Orientation = xlHidden;
59    }
60}
61with (ptObj.PivotFields("売上")) {
62    Orientation = xlDataField;
63    Function = xlSum;  // 合計の算出
64    Caption = "売上・計";
65    NumberFormat = "#,##0";
66}
67with (ptObj.PivotFields("仕入原価")) {
68    Orientation = xlDataField;
69    Function = xlSum;
70    Caption = "仕入原価・計";
71    NumberFormat = "#,##0";
72}
73ptObj.DataPivotField.Name = "合計値";
74wb.SaveAs(bookPath, xlOpenXMLWorkbook);
75exlApp.Quit();
76
77function ReadFile(filename) {
78    var fso = WScript.CreateObject("Scripting.FileSystemObject");
79    var path = fso.GetAbsolutePathName(filename);
80    var MyStr = null;
81    if (fso.FileExists(path)) {
82        var fobj = fso.OpenTextFile(path, 1);
83        MyStr = fobj.ReadAll();
84        fobj.Close();
85    }
86    return MyStr;
87}

目次に戻る

4.　JScript(オリジナルの配列, hash を利用)

　半年単位のグループ化、各月二分類のグループ化(15日までと16日以降)があります。

　はいれつ、hash(連想配列)は、JScriptオリジナルのものを利用。

(1)　半年単位のグループ化

 1var fso, bookPath, srcPath;
 2var exlApp, wb, ws, areaName;
 3var ptCache, ptObj;
 4var addrAry, nameAry, monthVal, vAry, i;
 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);
15areaName = "[pt_source02.xls]" + ws.Name + "!" + ws.UsedRange.Address
16wb = exlApp.Workbooks.Add();  // Workbookの新規作成
17ws = wb.WorkSheets(1)
18ws.Activate;
19
20ptCache = wb.PivotCaches().Create(xlDatabase, areaName);
21ptObj = ptCache.CreatePivotTable(
22    "R1C1", "ピボット01");
23
24addrAry = [];
25nameAry = [];
26with (ptObj.PivotFields("日付")) {
27    Orientation = xlColumnField;
28    LabelRange.Value = "期間区分";
29    for(i = 1; i <= PivotItems.Count; i++) {
30        itmRng = PivotItems(i).LabelRange;
31        vAry = PivotItems(i).Name.split('/');
32        monthVal = parseInt(vAry[0]);
33        nameNow = (monthVal < 7) ? vAry[2] + "上半期" :
34            vAry[2] + "下半期";
35        if (i === 1) {
36            addrAry.push(itmRng.Address);  // 始点を記録
37            nameAry.push(nameNow);
38            nameOld = nameNow;
39        } else if (nameNow !== nameOld) {
40            addrAry[addrAry.length-1] = addrAry[addrAry.length-1] +
41                ":" + PivotItems(i-1).LabelRange.Address;  // 終点を記録
42            addrAry.push(itmRng.Address);  // 始点を記録
43            nameAry.push(nameNow);
44            nameOld = nameNow;
45        }
46        if (i === PivotItems.Count) {
47            addrAry[addrAry.length-1] = addrAry[addrAry.length-1] +
48                ":" + itmRng.Address;  // 終点を記録
49        }
50    }
51    if (addrAry.length > 1) {  // グループが２以上ある
52        for(i = 0; i < addrAry.length; i++) {
53            ws.Range(addrAry[i]).Group;
54        }
55        for(i = 0; i < nameAry.length; i++) {
56            ParentField.PivotItems(i+1).Name = nameAry[i];
57        }
58        Orientation = xlHidden;
59    }
60}
61with (ptObj.PivotFields("売上")) {
62    Orientation = xlDataField;
63    Function = xlSum;  // 合計の算出
64    Caption = "売上・計";
65    NumberFormat = "#,##0";
66}
67with (ptObj.PivotFields("仕入原価")) {
68    Orientation = xlDataField;
69    Function = xlSum;
70    Caption = "仕入原価・計";
71    NumberFormat = "#,##0";
72}
73ptObj.DataPivotField.Orientation = xlRowField;
74ptObj.DataPivotField.Name = "合計値";
75wb.SaveAs(bookPath, xlOpenXMLWorkbook);
76exlApp.Quit();
77
78function ReadFile(filename) {
79    var fso = WScript.CreateObject("Scripting.FileSystemObject");
80    var path = fso.GetAbsolutePathName(filename);
81    var MyStr = null;
82    if (fso.FileExists(path)) {
83        var fobj = fso.OpenTextFile(path, 1);
84        MyStr = fobj.ReadAll();
85        fobj.Close();
86    }
87    return MyStr;
88}

目次に戻る

(2)　各月二分類のグループ化

 1var fso, bookPath, srcPath;
 2var exlApp, wb, ws, areaName;
 3var ptCache, ptObj;
 4var addrHash, keys, dayVal, vAry, i;
 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);
15areaName = "[pt_source02.xls]" + ws.Name + "!" + ws.UsedRange.Address
16wb = exlApp.Workbooks.Add();  // Workbookの新規作成
17ws = wb.WorkSheets(1)
18ws.Activate;
19
20ptCache = wb.PivotCaches().Create(xlDatabase, areaName);
21ptObj = ptCache.CreatePivotTable(
22    "R1C1", "ピボット01");
23
24addrHash = {};
25with (ptObj.PivotFields("日付")) {
26    Orientation = xlColumnField;
27    LabelRange.Value = "期間区分";
28    for(i = 1; i <= PivotItems.Count; i++) {
29        itmRng = PivotItems(i).LabelRange;
30        vAry = PivotItems(i).Name.split('/');
31        dayVal = parseInt(vAry[1]);
32        nameNow = (dayVal < 16) ? vAry[0] + "月上期" :
33            vAry[0] + "月下期";
34        if (i === 1) {
35            addrHash[nameNow] = itmRng.Address;  // 始点を記録
36            nameOld = nameNow;
37        } else if (nameNow !== nameOld) {
38            addrHash[nameOld] = addrHash[nameOld] +
39                ":" + PivotItems(i-1).LabelRange.Address;  // 終点を記録
40            addrHash[nameNow] = itmRng.Address;  // 始点を記録
41            nameOld = nameNow;
42        }
43        if (i === PivotItems.Count) {
44            addrHash[nameNow] = addrHash[nameNow] +
45                ":" + itmRng.Address;  // 終点を記録
46        }
47    }
48    keys = [];
49    for(var key in addrHash)  keys.push(key);
50    if (keys.length > 1) {  // グループが２以上ある
51        for(i = 0; i < keys.length; i++) {
52            ws.Range(addrHash[keys[i]]).Group;
53        }
54        for(i = 0; i < keys.length; i++) {
55            ParentField.PivotItems(i+1).Name = keys[i];
56        }
57        ParentField.Orientation = xlRowField;
58        ParentField.LabelRange.Value = "期間区分";
59        Orientation = xlHidden;
60    }
61}
62with (ptObj.PivotFields("売上")) {
63    Orientation = xlDataField;
64    Function = xlSum;  // 合計の算出
65    Caption = "売上・計";
66    NumberFormat = "#,##0";
67}
68with (ptObj.PivotFields("仕入原価")) {
69    Orientation = xlDataField;
70    Function = xlSum;
71    Caption = "仕入原価・計";
72    NumberFormat = "#,##0";
73}
74ptObj.DataPivotField.Name = "合計値";
75wb.SaveAs(bookPath, xlOpenXMLWorkbook);
76exlApp.Quit();
77
78function ReadFile(filename) {
79    var fso = WScript.CreateObject("Scripting.FileSystemObject");
80    var path = fso.GetAbsolutePathName(filename);
81    var MyStr = null;
82    if (fso.FileExists(path)) {
83        var fobj = fso.OpenTextFile(path, 1);
84        MyStr = fobj.ReadAll();
85        fobj.Close();
86    }
87    return MyStr;
88}

〜　以上　〜