ピボットテーブルの備忘録 ② クラス化（５）合計か平均か

先日から、マクロによるピボットテーブルの扱いを纏めている（備忘録）。
先日は、作成したピボットテーブルの書式を整えることに挑戦した。
infoment.hatenablog.com

今日は、集計方法の変更に挑戦する。

さて、先日からサンプルとして扱っている「なんちゃって個人情報」の集計結果について。ピボットテーブル作成直後は、各県の性別・婚姻別者の「年齢の合計」が表示されている。

しかし例えば上記の例のように、この表における愛知県の既婚男性の年齢が合計で1843歳と言われても、全くピンと来ない。例えばここは合計ではなく、せめて平均年齢としたいところ。

というわけで、メソッドを一つ追加してみた。

' 値フィールドの設定。
Public Sub SetValueField(Optional consolidation_function _
                            As XlConsolidationFunction = xlSum, _
                         Optional data_field_index _
                            As Long = 0)

    ' 指定した「data_field_index」番目が存在しない場合、処理を中断する。
    If data_field_index > Pvt.DataFields.Count Then Exit Sub

    ' 指定した「data_field_index」が「０番目」である場合、すべての
    ' データフィールドの集計方法を統一する。
    Dim arr As Variant
        Select Case data_field_index
            Case 0
                Dim DataField As PivotField
                    For Each DataField In Pvt.DataFields
                        
                        ' データフィールドの名称が、「平均 / 合計 / 年齢」のように
                        ' 意図しない表示になる場合がある。対策として、キャプションを
                        ' 一旦「 / 」で分割し、その最後の配列要素に集計名を付している。
                        ' 集計名は「AggregationMethodNameDict」を作成して取得している。
                        DataField.Function = consolidation_function
                        arr = Split(DataField.Caption, " / ")
                        DataField.Caption = AggregateMethodNameDict(consolidation_function) & _
                                            " / " & arr(UBound(arr))
                    Next
            Case Else
                With Pvt.DataFields(data_field_index)
                    .Function = consolidation_function
                    arr = Split(.Caption, " / ")
                    .Caption = AggregateMethodNameDict(consolidation_function) & _
                               " / " & arr(UBound(arr))
                End With
        End Select

End Sub

' 値フィールドの設定に使用する集計名辞書。
Private Property Get AggregateMethodNameDict() As Object
    Dim Dict As Object
    Set Dict = CreateObject("Scripting.Dictionary")
        
        Dict(xlSum) = "合計"
        Dict(xlCount) = "データの個数"
        Dict(xlAverage) = "平均"
        Dict(xlMax) = "最大値"
        Dict(xlMin) = "最小値"
        Dict(xlProduct) = "積"
        Dict(xlCountNums) = "数値の個数"
        Dict(xlStDev) = "標本標準偏差"
        Dict(xlStDevP) = "標準偏差"
        Dict(xlVar) = "標本分散"
        Dict(xlVarP) = "分散"
        
    Set AggregateMethodNameDict = Dict
End Property

それでは早速、実験してみよう。

Sub Test()
    Dim PvtTable As VBAProject.PvtTable
    Set PvtTable = New VBAProject.PvtTable
    
        If PvtTable.MakePivotTable(ActiveSheet.ListObjects(1)) = False Then
            MsgBox "ピボットテーブルの作成に失敗しました。"
            Exit Sub
        End If
        
        With PvtTable
            ' 各フィールドを設定。
            .SetFields xlPageField, "カレーの食べ方", "キャリア"
            .SetFields xlRowField, "都道府県", "性別"
            .SetFields xlColumnField, "婚姻"
            .SetFields xlDataField, 6
            
            ' 表形式で表示。
            .SetRowAxisLayout layout_row_type:=xlTabularRow
            
            ' 小計を非表示。
            .SetSubTotals subtotal_visible:=False
            
            ' 平均値で集計。
            .SetValueField xlAverage
        End With
End Sub

今回は、↓ この部分が追加となっている。

            ' 平均値で集計。
            .SetValueField xlAverage

結果が ↓ こちら。

小数点以下の表示など、修正すべき点はあるが、取り敢えず平均値への切り替えは上手く行ったので良しとしよう。

なお今回までのコードは、まとめてこちらに畳んでおく。

◆ソースコード（クリックで展開）◆

Option Explicit

Public Pvt As Excel.PivotTable

Dim PvtField As Excel.PivotField
Dim PvtItem As Excel.PivotItem

' ピボットテーブル作成。
Public Function MakePivotTable(source_data As ListObject, _
                      Optional sheet_name As String = vbNullString, _
                      Optional table_destination As String = "R3C1", _
                      Optional table_name As String = vbNullString) _
                      As Boolean
    
    ' 以下の場合、新規にシートを作成する。
    ' ① 指定された名前のシートが存在しない場合。
    ' ② シートの指定が無い場合。
    Dim Sh As Worksheet
    Dim Ws As Worksheet
        If sheet_name = vbNullString Then
            Set Sh = Sheets.Add
                ' シート名が無指定の場合、重複しないよう日付で命名。
                Sh.Name = "SheetForPivot_" & Format(Now, "yyyymmdd_hhmmss")
        Else
            ' 指定された名前のシートを探し、
            ' 見つかればShにセットする。
            For Each Ws In Worksheets
                If Ws.Name = sheet_name Then
                    Set Sh = Ws
                    Exit For
                End If
            Next
            ' 見つからなければ、新規に作成する。
            If Sh Is Nothing Then
                Set Sh = Sheets.Add
                    Sh.Name = sheet_name
            End If
        End If
        
        ' ピボットテーブル名が無指定の場合、重複しないように日付で命名。
        If table_name = vbNullString Then
            table_name = "PivotTable_" & Format(Now, "yyyymmdd_hhmmss")
        End If
    
    On Error GoTo er:
    Set Pvt = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
                                                SourceData:=source_data, _
                                                Version:=PvtVersion).CreatePivotTable _
                    (TableDestination:=Sh.Name & "!" & table_destination, _
                     TableName:=table_name, _
                     DefaultVersion:=PvtVersion)
        
        ' ピボットテーブル作成成功。
        MakePivotTable = True
        Exit Function
er:
        ' ピボットテーブル作成失敗。
        MakePivotTable = False
        On Error GoTo 0
End Function

' 各フィールドの設定。
Public Sub SetFields(field_orientation As XlPivotFieldOrientation, _
                     ParamArray field_names())
    
    ' ピボットテーブルの作成済み確認。
    If Pvt Is Nothing Then Exit Sub
    
    ' フィールドをセット。
    ' field_orientationの内訳は下記のとおり。
    ' ① xlPageField　：フィルター
    ' ② xlRowField 　：行
    ' ③ xlColumnField：列
    ' ④ xlDataField　：値
    
    ' フィルターはセットした順に位置が下になるので、指定した
    ' フィールド名の最後から逆順でセットする。
    Dim i As Long
    
    Select Case field_orientation
        
        Case xlPageField
            For i = UBound(field_names) To 0 Step -1
                Pvt.PivotFields(field_names(i)).Orientation = field_orientation
            Next
        
        Case Else
            For i = 0 To UBound(field_names)
                Pvt.PivotFields(field_names(i)).Orientation = field_orientation
            Next
    
    End Select
End Sub

' レポートのレイアウト変更。
Public Sub SetRowAxisLayout(Optional layout_row_type As XlLayoutRowType = xlTabularRow)
    ' ピボットテーブルの作成済み確認。
    If Pvt Is Nothing Then Exit Sub
    
    Pvt.RowAxisLayout layout_row_type
End Sub

' 小計の表示設定。
Public Sub SetSubTotals(Optional subtotal_visible As Boolean = False, _
                        Optional subtotal_location As XlSubtototalLocationType = xlAtBottom)
                        
    Select Case subtotal_visible
    
        ' 小計を表示する場合。
        Case True
            Pvt.SubtotalLocation subtotal_location
        
        ' 小計を表示しない場合。
        Case False
            On Error Resume Next
            For Each PvtField In Pvt.PivotFields
                PvtField.Subtotals(1) = True
                PvtField.Subtotals(1) = False
            Next
            
    End Select
End Sub

' 値フィールドの設定。
Public Sub SetValueField(Optional consolidation_function _
                            As XlConsolidationFunction = xlSum, _
                         Optional data_field_index _
                            As Long = 0)

    ' 指定した「data_field_index」番目が存在しない場合、処理を中断する。
    If data_field_index > Pvt.DataFields.Count Then Exit Sub

    ' 指定した「data_field_index」が「０番目」である場合、すべての
    ' データフィールドの集計方法を統一する。
    Dim arr As Variant
        Select Case data_field_index
            Case 0
                Dim DataField As PivotField
                    For Each DataField In Pvt.DataFields
                        
                        ' データフィールドの名称が、「平均 / 合計 / 年齢」のように
                        ' 意図しない表示になる場合がある。対策として、キャプションを
                        ' 一旦「 / 」で分割し、その最後の配列要素に集計名を付している。
                        ' 集計名は「AggregationMethodNameDict」を作成して取得している。
                        DataField.Function = consolidation_function
                        arr = Split(DataField.Caption, " / ")
                        DataField.Caption = AggregateMethodNameDict(consolidation_function) & _
                                            " / " & arr(UBound(arr))
                    Next
            Case Else
                With Pvt.DataFields(data_field_index)
                    .Function = consolidation_function
                    arr = Split(.Caption, " / ")
                    .Caption = AggregateMethodNameDict(consolidation_function) & _
                               " / " & arr(UBound(arr))
                End With
        End Select

End Sub

' 値フィールドの設定に使用する集計名辞書。
Private Property Get AggregateMethodNameDict() As Object
    Dim Dict As Object
    Set Dict = CreateObject("Scripting.Dictionary")
        
        Dict(xlSum) = "合計"
        Dict(xlCount) = "データの個数"
        Dict(xlAverage) = "平均"
        Dict(xlMax) = "最大値"
        Dict(xlMin) = "最小値"
        Dict(xlProduct) = "積"
        Dict(xlCountNums) = "数値の個数"
        Dict(xlStDev) = "標本標準偏差"
        Dict(xlStDevP) = "標準偏差"
        Dict(xlVar) = "標本分散"
        Dict(xlVarP) = "分散"
        
    Set AggregateMethodNameDict = Dict
End Property

Private Property Get PvtVersion() As Long
    Select Case CLng(Application.Version)
        ' 2010の場合。
        Case 14
            PvtVersion = xlPivotTableVersion14
        ' 2013の場合。
        Case 15
            PvtVersion = xlPivotTableVersion15
        ' 2016の場合。
        Case 16
            PvtVersion = 6
    End Select
End Property

Private Sub Class_Terminate()
    With Pvt.TableRange2
        .Font.Name = "メイリオ"
        .Font.Size = 10
        .RowHeight = 20
        .EntireColumn.AutoFit
    End With
End Sub

次回に続きます。

参考まで。