ExcelVBAとピボットテーブル：第７回 列範囲のグループ化および二段階集計 に関連する VBAマクロ、VBScript、JScriptを掲載します。
その第３弾「二段階集計」です。
「四半期単位から半年単位を生成」は、列範囲のグループ化＋二段階集計、
「支店ごとの利益・利益率を把握」は、xlConsolidationによる集計＋二段階集計。
1Option Explicit 2Sub Macro1() 3 Dim pName As String, bName As String 4 Dim ws As WorkSheet, rng As Range, rngName As String 5 Dim ptCache As PivotCache, ptObj As PivotTable 6 Dim argAry(6) As Boolean, i As Integer 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 Set ws = WorkSheets(2) ' 第２シートにソースピボットを作成 15 16 Set ptCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _ 17 SourceData:=rngName) 18 Set ptObj = ptCache.CreatePivotTable( _ 19 TableDestination:=ws.Name & "!R1C1", TableName:="SourcePivot01") 20 For i = 0 To 6 21 argAry(i) = False 22 Next 23 argAry(5) = True ' 6番目の要素をtrueに。四半期単位の指定 24 With ptObj.PivotFields("日付") 25 .Orientation = xlRowField 26 .LabelRange.Value = "日付2" 27 .DataRange.Cells(1).Group Periods:=argAry 28 End With 29 With ptObj.PivotFields("売上") 30 .Orientation = xlDataField 31 .Function = xlSum ' 合計を算出 32 .Caption = "売上2" 33 End With 34 With ptObj.PivotFields("仕入原価") 35 .Orientation = xlDataField 36 .Function = xlSum 37 .Caption = "仕入原価2" 38 End With 39 ptObj.ColumnGrand = False ' 総計を非表示 40 41 Set rng = ptObj.TableRange1 ' 第１ピボットの領域 42 Set rng = rng.Offset(1).Resize(rng.Rows.Count-1) ' 1行目を対象外 43 rngName = ws.Name & "!" & rng.Address 44 45 Set ws = WorkSheets(1) 46 ws.Activate ' 第１シートをアクティブに 47 Set ptCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _ 48 SourceData:=rngName) 49 Set ptObj = ptCache.CreatePivotTable( _ 50 TableDestination:="R1C1", TableName:="ピボット01") 51 With ptObj.PivotFields("日付2") 52 .Orientation = xlColumnField 53 .LabelRange.Value = "期間区分" 54 Application.Union(.PivotItems(1).LabelRange, _ 55 .PivotItems(2).LabelRange).Group 56 Application.Union(.PivotItems(3).LabelRange, _ 57 .PivotItems(4).LabelRange).Group 58 With .ParentField 59 .PivotItems(1).Name = "上半期" 60 .PivotItems(2).Name = "下半期" 61 .Subtotals(1) = True 62 End With 63 End With 64 With ptObj.PivotFields("売上2") 65 .Orientation = xlDataField 66 .Function = xlSum ' 合計を算出 67 .Caption = "売上・計" 68 .NumberFormat = "#,##0" 69 End With 70 With ptObj.PivotFields("仕入原価2") 71 .Orientation = xlDataField 72 .Function = xlSum 73 .Caption = "仕入原価・計" 74 .NumberFormat = "#,##0" 75 End With 76 ptObj.DataPivotField.Orientation = xlRowField 77 ptObj.DataPivotField.Name = "合計値" 78End Sub
1Option Explicit 2Sub Macro1() 3 Dim pName As String, bName As String 4 Dim ws As WorkSheet, rng As Range, rngName As String 5 Dim ptCache As PivotCache, ptObj As PivotTable 6 Dim srcAry As Variant, i As Integer, vObj As Variant 7 8 pName = ThisWorkbook.Path ' 本ワークブックのフォルダ名 9 bName = ThisWorkbook.Name ' 本ワークブックの名前 10 Workbooks.Open pName & "\pt_source02.xls" ' ソースデータを開く 11 ReDim srcAry(WorkSheets.Count-1) ' 配列として宣言 12 For i = 0 To WorkSheets.Count-1 ' シート枚数だけ処理 13 Set ws = WorkSheets(i+1) 14 Set rng = ws.UsedRange ' 書き込みのある領域全体 15 srcAry(i) = Array("[" & ActiveWorkbook.Name & "]" & ws.Name & _ 16 "!" & rng.Address(True, True, xlR1C1), ws.Name) 17 Next 18 Workbooks(bName).Activate ' 本ワークブックをアクティブに 19 Set ws = WorkSheets(2) 20 21 Set ptCache = ActiveWorkbook.PivotCaches.Create( _ 22 SourceType:=xlConsolidation, _ 23 SourceData:=srcAry) 24 Set ptObj = ptCache.CreatePivotTable( _ 25 TableDestination:=ws.Name & "!R1C1", TableName:="SourcePivit01") 26 27 ptObj.RowFields(1).Orientation = xlHidden ' 日付を非表示に 28 ptObj.ColumnFields(1).PivotItems("商品").Visible = False 29 ptObj.DataFields(1).Function = xlSum 30 With ptObj.PageFields(1) 31 .Orientation = xlRowField 32 .LabelRange.Value = "支店" 33 End With 34 ptObj.RowGrand = False 35 ptObj.ColumnGrand = False 36 37 Set rng = ptObj.TableRange1 ' 第１ピボットの領域 38 Set rng = rng.Offset(1).Resize(rng.Rows.Count-1) ' 1行目を対象外 39 rngName = ws.Name & "!" & rng.Address 40 41 Set ws = WorkSheets(1) 42 ws.Activate ' 第１シートをアクティブに 43 Set ptCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _ 44 SourceData:=rngName) 45 Set ptObj = ptCache.CreatePivotTable( _ 46 TableDestination:="R1C1", TableName:="ピボット01") 47 With ptObj.PivotFields("支店") 48 .Orientation = xlRowField 49 .LabelRange.Value = "支店" 50 i = 0 51 For Each vObj In Array("東京支店", "名古屋支店", "大阪支店") 52 i = i + 1 53 .PivotItems(vObj).Position = i 54 Next 55 End With 56 SetDataFld ptObj.PivotFields("売上"), xlSum, "売上(a)", "#,##0" 57 SetDataFld ptObj.PivotFields("仕入原価"), xlSum, "仕入原価(b)", "#,##0" 58 SetDataFld ptObj.CalculatedFields.Add("利益", "=売上 - 仕入原価"),, _ 59 "利益(c:a-b)", "#,##0" 60 SetDataFld ptObj.CalculatedFields.Add("利益率", "=利益 / 売上"),, _ 61 "利益率(d:c/a)", "0.0%" 62End Sub 63 64Sub SetDataFld(ByRef ptFld As PivotField, Optional ByVal funcVal, _ 65 Optional ByVal capName, Optional ByVal numFmt) 66 With ptFld 67 .Orientation = xlDataField 68 If Not IsMissing(funcVal) Then .Function = funcVal 69 If Not IsMissing(capName) Then .Caption = capName 70 If Not IsMissing(numFmt) Then .NumberFormat = numFmt 71 End With 72End Sub
「四半期単位から半年単位を生成」は、列範囲のグループ化＋二段階集計、
「支店ごとの利益・利益率を把握」は、xlConsolidationによる集計＋二段階集計。
1Option Explicit 2Dim fso, bookPath, srcPath 3Dim exlApp, wbObj, ws, rng, rngName 4Dim ptCache, ptObj 5Dim argAry(6), 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を見える状態に 14Set wbObj = exlApp.Workbooks.Open(srcPath) 15Set ws = wbObj.WorkSheets(1) 16rngName = "[pt_source02.xls]" & ws.Name & "!" & ws.UsedRange.Address 17Set wbObj = exlApp.Workbooks.Add() ' Workbookの新規作成 18Set ws = wbObj.WorkSheets(2) ' 第２シートにソースピボットを作成 19 20Set ptCache = wbObj.PivotCaches.Create(xlDatabase, rngName) 21Set ptObj = ptCache.CreatePivotTable( _ 22 ws.Name & "!R1C1", "SourcePivot01") 23For i = 0 To 6 24 argAry(i) = False 25Next 26argAry(5) = True ' 6番目の要素をtrueに。四半期単位の指定 27With ptObj.PivotFields("日付") 28 .Orientation = xlRowField 29 .LabelRange.Value = "日付2" 30 .DataRange.Cells(1).Group ,,,argAry 31End With 32With ptObj.PivotFields("売上") 33 .Orientation = xlDataField 34 .Function = xlSum ' 合計の算出 35 .Caption = "売上2" 36End With 37With ptObj.PivotFields("仕入原価") 38 .Orientation = xlDataField 39 .Function = xlSum 40 .Caption = "仕入原価2" 41End With 42ptObj.ColumnGrand = False ' 総計を非表示 43 44Set rng = ptObj.TableRange1 ' 第１ピボットの領域 45Set rng = rng.Offset(1).Resize(rng.Rows.Count-1) ' 1行目を対象外 46rngName = ws.Name & "!" & rng.Address 47 48Set ws = wbObj.WorkSheets(1) 49ws.Activate ' 第１シートをアクティブに 50Set ptCache = wbObj.PivotCaches.Create(xlDatabase, rngName) 51Set ptObj = ptCache.CreatePivotTable("R1C1", "ピボット01") 52With ptObj.PivotFields("日付2") 53 .Orientation = xlColumnField 54 .LabelRange.Value = "期間区分" 55 exlApp.Union(.PivotItems(1).LabelRange, _ 56 .PivotItems(2).LabelRange).Group 57 exlApp.Union(.PivotItems(3).LabelRange, _ 58 .PivotItems(4).LabelRange).Group 59 With .ParentField 60 .PivotItems(1).Name = "上半期" 61 .PivotItems(2).Name = "下半期" 62 .Subtotals(1) = True 63 End With 64End With 65With ptObj.PivotFields("売上2") 66 .Orientation = xlDataField 67 .Function = xlSum ' 合計を算出 68 .Caption = "売上・計" 69 .NumberFormat = "#,##0" 70End With 71With ptObj.PivotFields("仕入原価2") 72 .Orientation = xlDataField 73 .Function = xlSum 74 .Caption = "仕入原価・計" 75 .NumberFormat = "#,##0" 76End With 77ptObj.DataPivotField.Orientation = xlRowField 78ptObj.DataPivotField.Name = "合計値" 79wbObj.SaveAs bookPath, xlOpenXMLWorkbook 80exlApp.quit 81 82Sub Include(ByVal FileName) 83 Dim fso, FileObj, MyStr 84 Set fso = CreateObject("Scripting.FileSystemObject") 85 Set FileObj = fso.OpenTextFile(fso.GetAbsolutePathName(FileName)) 86 MyStr = FileObj.ReadAll() 87 FileObj.Close 88 Set fso = Nothing 89 Set FileObj = Nothing 90 ExecuteGlobal MyStr 91End Sub
1Option Explicit 2Dim fso, bookPath, srcPath 3Dim exlApp, wbObj, ws, rng, rngName, vObj 4Dim ptCache, ptObj 5Dim srcAry, 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 wbObj = exlApp.ActiveWorkbook 16ReDim srcAry(wbObj.WorkSheets.Count-1) ' 配列として宣言 17For i = 1 To wbObj.WorkSheets.Count ' シート枚数だけ処理 18 Set ws = wbObj.WorkSheets(i) 19 Set rng = ws.UsedRange ' 書き込みのある領域全体 20 srcAry(i-1) = Array("[" & wbObj.Name & "]" & ws.Name & _ 21 "!" & rng.Address(True, True, xlR1C1), ws.Name) 22Next 23Set wbObj = exlApp.Workbooks.Add() ' Workbookの新規作成 24Set ws = wbObj.WorkSheets(2) 25 26Set ptCache = wbObj.PivotCaches.Create(xlConsolidation, srcAry) 27Set ptObj = ptCache.CreatePivotTable( _ 28 ws.Name & "!R1C1", "BasePivot") 29 30ptObj.RowFields(1).Orientation = xlHidden ' 日付を非表示に 31ptObj.ColumnFields(1).PivotItems("商品").Visible = False 32ptObj.DataFields(1).Function = xlSum 33With ptObj.PageFields(1) 34 .Orientation = xlRowField ' ページフィールドを列フィールドに変更 35 .LabelRange.Value = "支店" 36End With 37ptObj.RowGrand = False 38ptObj.ColumnGrand = False 39 40Set rng = ptObj.TableRange1 ' 第１ピボットの領域 41Set rng = rng.Offset(1).Resize(rng.Rows.Count-1) ' 1行目を対象外 42rngName = ws.Name & "!" & rng.Address 43 44Set ws = wbObj.WorkSheets(1) 45ws.Activate ' 第１シートをアクティブに 46Set ptCache = wbObj.PivotCaches.Create(xlDatabase, rngName) 47Set ptObj = ptCache.CreatePivotTable("R1C1", "ピボット01") 48 49With ptObj.PivotFields("支店") 50 .Orientation = xlRowField 51 .LabelRange.Value = "支店" 52 i = 0 53 For Each vObj In Array("東京支店", "名古屋支店", "大阪支店") 54 i = i + 1 55 .PivotItems(vObj).Position = i 56 Next 57End With 58SetDataFld ptObj.PivotFields("売上"), xlSum, "売上(a)", "#,##0" 59SetDataFld ptObj.PivotFields("仕入原価"), xlSum, "仕入原価(b)", "#,##0" 60SetDataFld ptObj.CalculatedFields.Add("利益", "=売上 - 仕入原価"),, _ 61 "利益(c:a-b)", "#,##0" 62SetDataFld ptObj.CalculatedFields.Add("利益率", "=利益 / 売上"),, _ 63 "利益率(d:c/a)", "0.0%" 64wbObj.SaveAs bookPath, xlOpenXMLWorkbook 65exlApp.quit 66 67Sub SetDataFld(ByRef ptFld, ByVal funcVal, ByVal capName, ByVal numFmt) 68 With ptFld 69 .Orientation = xlDataField 70 If Not IsMissing(funcVal) Then .Function = funcVal 71 If Not IsMissing(capName) Then .Caption = capName 72 If Not IsNull(numFmt) Then .NumberFormat = numFmt 73 End With 74End Sub 75 76Function IsMissing(p) 77 IsMissing = (VarType(p) = vbError) 78End Function 79 80Sub Include(ByVal FileName) 81 Dim fso, FileObj, MyStr 82 Set fso = CreateObject("Scripting.FileSystemObject") 83 Set FileObj = fso.OpenTextFile(fso.GetAbsolutePathName(FileName)) 84 MyStr = FileObj.ReadAll() 85 FileObj.Close 86 Set fso = Nothing 87 Set FileObj = Nothing 88 ExecuteGlobal MyStr 89End Sub
「四半期単位から半年単位を生成」は、列範囲のグループ化＋二段階集計、
「支店ごとの利益・利益率を把握」は、xlConsolidationによる集計＋二段階集計。
1var fso, bookPath, srcPath; 2var exlApp, wb, ws, rng, rngName; 3var ptCache, ptObj, argAry, 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を見える状態に 12wb = exlApp.Workbooks.Open(srcPath); 13ws = wb.WorkSheets(1); 14rngName = "[pt_source02.xls]" + ws.Name + "!" + ws.UsedRange.Address; 15wb = exlApp.Workbooks.Add(); // Workbookの新規作成 16ws = wb.WorkSheets(2) // 第２シートにソースピボットを作成 17 18ptCache = wb.PivotCaches().Create(xlDatabase, rngName); 19ptObj = ptCache.CreatePivotTable( 20 ws.Name + "!R1C1", "SourcePivot01"); 21argAry = WScript.CreateObject("System.Collections.ArrayList"); 22for(i=0; i<=6; i++) { 23 argAry.add(false); 24} 25argAry(5) = true; // 6番目の要素をtrueに。四半期単位の指定 26with (ptObj.PivotFields("日付")) { 27 Orientation = xlRowField; 28 LabelRange.Value = "日付2"; 29 DataRange.Cells(1).Group(null, null, null, argAry.ToArray()); 30} 31with (ptObj.PivotFields("売上")) { 32 Orientation = xlDataField; 33 Function = xlSum; // 合計の算出 34 Caption = "売上2"; 35} 36with (ptObj.PivotFields("仕入原価")) { 37 Orientation = xlDataField; 38 Function = xlSum; 39 Caption = "仕入原価2"; 40} 41ptObj.ColumnGrand = false; 42 43rng = ptObj.TableRange1; // 第１ピボットの領域 44rng = rng.Offset(1).Resize(rng.Rows.Count-1); // 1行目を対象外 45rngName = ws.Name + "!" + rng.Address; 46 47ws = wb.WorkSheets(1); 48ws.Activate; // 第１シートをアクティブに 49ptCache = wb.PivotCaches().Create(xlDatabase, rngName); 50ptObj = ptCache.CreatePivotTable("R1C1", "ピボット01"); 51with (ptObj.PivotFields("日付2")) { 52 Orientation = xlColumnField; 53 LabelRange.Value = "期間区分"; 54 exlApp.Union(PivotItems(1).LabelRange, 55 PivotItems(2).LabelRange).Group; 56 exlApp.Union(PivotItems(3).LabelRange, 57 PivotItems(4).LabelRange).Group; 58 with (ParentField) { 59 PivotItems(1).Name = "上半期"; 60 PivotItems(2).Name = "下半期"; 61 Subtotals(1) = true; 62 } 63} 64with (ptObj.PivotFields("売上2")) { 65 Orientation = xlDataField; 66 Function = xlSum; // 合計を算出 67 Caption = "売上・計"; 68 NumberFormat = "#,##0"; 69} 70with (ptObj.PivotFields("仕入原価2")) { 71 Orientation = xlDataField; 72 Function = xlSum; 73 Caption = "仕入原価・計"; 74 NumberFormat = "#,##0"; 75} 76ptObj.DataPivotField.Orientation = xlRowField; 77ptObj.DataPivotField.Name = "合計値"; 78wb.SaveAs(bookPath, xlOpenXMLWorkbook); 79exlApp.Quit(); 80 81function ReadFile(filename) { 82 var fso = WScript.CreateObject("Scripting.FileSystemObject"); 83 var path = fso.GetAbsolutePathName(filename); 84 var MyStr = null; 85 if (fso.FileExists(path)) { 86 var fobj = fso.OpenTextFile(path, 1); 87 MyStr = fobj.ReadAll(); 88 fobj.Close(); 89 } 90 return MyStr; 91}
1var fso, bookPath, srcPath; 2var exlApp, wb, ws, rng, rngName; 3var ptCache, ptObj, srcAry, argAry, 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); 13wb = exlApp.ActiveWorkbook; 14srcAry = WScript.CreateObject("System.Collections.ArrayList"); 15argAry = WScript.CreateObject("System.Collections.ArrayList"); 16for(i = 1; i <= wb.WorkSheets.Count; i++) { // シート枚数だけ処理 17 ws = wb.WorkSheets(i); 18 rng = ws.UsedRange; // 書き込みのある領域全体 19 argAry.add("[" + wb.Name + "]" + ws.Name + 20 "!" + rng.Address(true, true, xlR1C1)); 21 argAry.add(ws.Name); 22 srcAry.add(argAry.ToArray()); 23 argAry.Clear(); 24} 25wb = exlApp.Workbooks.Add(); // Workbookの新規作成 26ws = wb.WorkSheets(2); 27 28ptCache = wb.PivotCaches().Create(xlConsolidation, srcAry.ToArray()); 29ptObj = ptCache.CreatePivotTable( 30 ws.Name + "!R1C1", "SourcePivot01"); 31 32ptObj.RowFields(1).Orientation = xlHidden; // 日付を非表示に 33ptObj.ColumnFields(1).PivotItems("商品").Visible = false; 34ptObj.DataFields(1).Function = xlSum; 35with (ptObj.PageFields(1)) { 36 Orientation = xlRowField; 37 LabelRange.Value = "支店"; 38} 39ptObj.RowGrand = false; 40ptObj.ColumnGrand = false; 41 42rng = ptObj.TableRange1; // 第１ピボットの領域 43rng = rng.Offset(1).Resize(rng.Rows.Count-1); // 1行目を対象外 44rngName = ws.Name + "!" + rng.Address; 45 46ws = wb.WorkSheets(1); 47ws.Activate; // 第１シートをアクティブに 48ptCache = wb.PivotCaches().Create(xlDatabase, rngName); 49ptObj = ptCache.CreatePivotTable("R1C1", "ピボット01"); 50with (ptObj.PivotFields("支店")) { 51 Orientation = xlRowField; 52 LabelRange.Value = "支店"; 53 vAry = ["東京支店", "名古屋支店", "大阪支店"]; 54 for(i=0; i<vAry.length; i++) { 55 PivotItems(vAry[i]).Position = i+1; 56 } 57} 58SetDataFld(ptObj.PivotFields("売上"), xlSum, "売上(a)", "#,##0"); 59SetDataFld(ptObj.PivotFields("仕入原価"), xlSum, "仕入原価(b)", "#,##0"); 60SetDataFld(ptObj.CalculatedFields().Add("利益", "=売上 - 仕入原価"), null, 61 "利益(c:a-b)", "#,##0"); 62SetDataFld(ptObj.CalculatedFields().Add("利益率", "=利益 / 売上"), null, 63 "利益率(d:c/a)", "0.0%"); 64wb.SaveAs(bookPath, xlOpenXMLWorkbook); 65exlApp.Quit(); 66 67function SetDataFld(ptFld, funcVal, capName, numFmt) { 68 with (ptFld) { 69 Orientation = xlDataField 70 if (funcVal !== null) Function = funcVal; 71 if (capName !== null) Caption = capName; 72 if (numFmt !== null) NumberFormat = numFmt; 73 } 74} 75 76function ReadFile(filename) { 77 var fso = WScript.CreateObject("Scripting.FileSystemObject"); 78 var path = fso.GetAbsolutePathName(filename); 79 var MyStr = null; 80 if (fso.FileExists(path)) { 81 var fobj = fso.OpenTextFile(path, 1); 82 MyStr = fobj.ReadAll(); 83 fobj.Close(); 84 } 85 return MyStr; 86}
〜 以上 〜