前回の[名前の管理]へ追加は、ピボットテーブルを作りたかったから書いた訳で。
こちらもスクリプト実行ライブラリに登録しておきます。
ピボットテーブル作成
データ集計が好きな人は良く使ってるコレです。
WinActorでピボット使いたいなんて思っちゃう猛者ならお馴染みのヤツ。
このライブラリの前に[名前の管理]からセル範囲の名前を追加し、定義済みの名前をデータソース名に指定して、このノードを実行して下さい。
集計の列と行は、カンマ区切りにすることで複数指定できます。
集計項目の集計内容は、プルダウン式で「合計,平均,最大値,最小値,カウント」から選べます。
出力シート名は、以下の通りの動きをします。
- シート名が存在すれば、そのシートに出力する。
- 同じシート名が無ければ、新しくその名前のシートを作成する。
- 空白を指定した場合、新しいシートを作成して出力します。
出力セルは、R1C1形式で出力範囲の左上セルを指定します。
「スクリプト実行」ノードの実装イメージ
スクリプトタブにこれを張り付け。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 |
' ==== プロパティ ==================================================== fname = !ファイル名! AreaName = !データソース名! ColNames = !列項目(カンマ区切り)! RowNames = !行項目(カンマ区切り)! ValName1 = !集計項目! ValFunc1 = !集計|合計,平均,最大値,最小値,カウント! sheetName = !出力シート名! PutRange = !出力セル(R1C1形式)! ' ====指定されたファイルを開く==================================================== ' ファイルのパスをフルパスに変換する Set fso = CreateObject("Scripting.FileSystemObject") absname = fso.GetAbsolutePathName(fname) If StrComp(UCase(fname), UCase(absname)) = 0 Then filePath = absname Else folderPath = GetUMSVariable("$SCENARIO-FOLDER") filePath = fso.GetAbsolutePathName(fso.BuildPath(folderPath, fname)) End If ' workbookオブジェクトを取得する Set workbook = Nothing On Error Resume Next ' 既存のエクセルが起動されていれば警告を抑制する Set existingXlsApp = Nothing Set existingXlsApp = GetObject(, "Excel.Application") existingXlsApp.DisplayAlerts = False ' 一先ずWorkbookオブジェクトをGetObjectしてみる Set workbook = GetObject(filePath) Set xlsApp = workbook.Parent ' GetObjectによって新規に開かれたWorkbookなら ' 変数にNothingを代入することで参照が0になるため ' 自動的に閉じられる。 Set workbook = Nothing ' Workbookがまだ存在するか確認する For Each book In xlsApp.Workbooks If StrComp(book.FullName, filePath, 1) = 0 Then ' Workbookがまだ存在するので、このWorkbookは既に開かれていたもの Set workbook = book xlsApp.Visible = True End If Next ' Workbookが存在しない場合は、新たに開く。 If workbook Is Nothing Then Set xlsApp = Nothing ' Excelが既に開かれていたならそれを再利用する If Not existingXlsApp Is Nothing Then Set xlsApp = existingXlsApp xlsApp.Visible = True Else Set xlsApp = CreateObject("Excel.Application") xlsApp.Visible = True End If Set workbook = xlsApp.Workbooks.Open(filePath) End If ' 警告の抑制を元に戻す existingXlsApp.DisplayAlerts = True Set existingXlsApp = Nothing On Error Goto 0 If workbook Is Nothing Then Err.Raise 1, "", "指定されたファイルを開くことができません。" End If ' ====指定されたシートを取得（無ければ作る）========================================== Set worksheet = Nothing On Error Resume Next ' シート名が指定されていない場合は、新しいシートを生成する If sheetName = "" Then workbook.Sheets.Add Set worksheet = workbook.ActiveSheet Else For Each sht In workbook.Worksheets If sht.Name = sheetName Then Set worksheet = sht End If Next If worksheet Is Nothing Then workbook.Sheets.Add Set worksheet = workbook.ActiveSheet worksheet.Name = sheetName End If End If On Error Goto 0 worksheet.Activate ' ====ハイライトを表示する======================================================== ' HwndプロパティはExcel2002以降のみ対応 On Error Resume Next ShowUMSHighlight(xlsApp.Hwnd) On Error Goto 0 ' ====ピボットテーブルを作る====================================================== xlDatabase = 1 xlRowField = 1 xlColumnField = 2 xlSum = &HFFFFEFC3 xlAverage = &HFFFFEFF6 xlMax = &HFFFFEFD8 xlMin = &HFFFFEFD5 xlCount = &HFFFFEFF0 PutRange = worksheet.Name & "!" & PutRange Set pvCache = workbook.PivotCaches.Create(xlDatabase, AreaName) Set pvTable = pvCache.CreatePivotTable(PutRange) If Len(ColNames) > 0 Then Labels = split(ColNames, ",") For i=0 To UBound(Labels) With pvTable.PivotFields(Labels(i)) .Orientation = xlColumnField .Position = i + 1 End With Next End If If Len(RowNames) > 0 Then Labels = split(RowNames, ",") For i=0 To UBound(Labels) With pvTable.PivotFields(Labels(i)) .Orientation = xlRowField .Position = i + 1 End With Next End If FuncOpt = 1 Select Case ValFunc1 Case "合計" FuncOpt = xlSum Case "平均" FuncOpt = xlAverage Case "最大値" FuncOpt = xlMax Case "最小値" FuncOpt = xlMin Case "カウント" FuncOpt = xlCount End Select If Len(ValName1) > 0 Then pvTable.AddDataField pvTable.PivotFields(ValName1), ValFunc1 & " / " & ValName1, FuncOpt End If Set xlsApp = Nothing Set worksheet = Nothing Set workbook = Nothing Set fso = Nothing |
注釈タブにはコメントをこんな感じで。
Excelの機能、ピボットテーブルを作成します。
・「データソース名」には[名前の管理]で定義したセル範囲の名前を指定します。
・「列項目」、「行項目」は、カンマ区切りで複数指定できます。
・「列項目」、「行項目」、「集計項目」は空白の場合、適用されません。
・「出力シート名」は、シート名が存在しない場合、その名前のシートを作成します。
空白の場合は、デフォルト名で新しいシートを作成して出力します。
・「出力セル」には、R1C1形式でピボットテーブルの左上位置のセルを指定します。