[WinActor]Excel操作 – ピボットテーブル作成

前回の[名前の管理]へ追加は、ピボットテーブルを作りたかったから書いた訳で。

[WinActor]Excel操作 – 名前の管理へ追加

こちらもスクリプト実行ライブラリに登録しておきます。

[WINACTOR]スクリプト実行ライブラリ

ピボットテーブル作成

データ集計が好きな人は良く使ってるコレです。

WinActorでピボット使いたいなんて思っちゃう猛者ならお馴染みのヤツ。

このライブラリの前に[名前の管理]からセル範囲の名前を追加し、定義済みの名前をデータソース名に指定して、このノードを実行して下さい。

集計の列と行は、カンマ区切りにすることで複数指定できます。

集計項目の集計内容は、プルダウン式で「合計,平均,最大値,最小値,カウント」から選べます。

出力シート名は、以下の通りの動きをします。

• シート名が存在すれば、そのシートに出力する。
• 同じシート名が無ければ、新しくその名前のシートを作成する。
• 空白を指定した場合、新しいシートを作成して出力します。

出力セルは、R1C1形式で出力範囲の左上セルを指定します。

「スクリプト実行」ノードの実装イメージ

スクリプトタブにこれを張り付け。

' ==== プロパティ ====================================================
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形式でピボットテーブルの左上位置のセルを指定します。