レポートのレイアウトを表形式で表示（ピボットテーブル）

昨日は、指定した内容で配列がサクッと作成される関数を作ってみた。
infoment.hatenablog.com

話の流れは、「１から１００の偶数の和を求めるワンライナーに対応するため作った」であるが、切っ掛けは別の事案だった。

今回は説明のため、いつもの「なんちゃって個人情報」のお世話になって、こんなピボットテーブルを作成してみた。

表が縦長になって見難いため、レポートのレイアウトを表形式で表示しよう。

結果、見た目はこのようになる。

これをマクロの記録でコード化すると、このような結果になった。

Sub Macro2()
    ActiveSheet.PivotTables("ピボットテーブル1").RowAxisLayout xlTabularRow
    ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("名前").Subtotals = Array(False, _
        False, False, False, False, False, False, False, False, False, False, False)
    ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("ふりがな").Subtotals = Array( _
        False, False, False, False, False, False, False, False, False, False, False, False)
    ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("アドレス").Subtotals = Array( _
        False, False, False, False, False, False, False, False, False, False, False, False)
    ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("性別").Subtotals = Array(False, _
        False, False, False, False, False, False, False, False, False, False, False)
    ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("年齢").Subtotals = Array(False, _
        False, False, False, False, False, False, False, False, False, False, False)
    ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("誕生日").Subtotals = Array(False _
        , False, False, False, False, False, False, False, False, False, False, False)
    ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("婚姻").Subtotals = Array(False, _
        False, False, False, False, False, False, False, False, False, False, False)
    ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("都道府県").Subtotals = Array( _
        False, False, False, False, False, False, False, False, False, False, False, False)
    ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("携帯").Subtotals = Array(False, _
        False, False, False, False, False, False, False, False, False, False, False)
    ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("キャリア").Subtotals = Array( _
        False, False, False, False, False, False, False, False, False, False, False, False)
    ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("カレーの食べ方").Subtotals = Array( _
        False, False, False, False, False, False, False, False, False, False, False, False)
End Sub

何という見難さか。それではこれを、きれいにしてみよう。
まず、ほとんどの行に書かれている
「ActiveSheet.PivotTables("ピボットテーブル1")」
に着目した。Withステートメントで括っても良いが、今回は変数に置き換える。

毎回「ピボットテーブル1」という名前になる保証もないので、
「このシートにある１つ目のピボットテーブル」
という表現に改める。

    Dim Pvt As Excel.PivotTable
    Set Pvt = ActiveSheet.PivotTables(1)

文字量が一気に減らせた。

Sub Macro2()

    Dim Pvt As Excel.PivotTable
    Set Pvt = ActiveSheet.PivotTables(1)

    Pvt.RowAxisLayout xlTabularRow
    Pvt.PivotFields("名前").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
    Pvt.PivotFields("ふりがな").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
    Pvt.PivotFields("アドレス").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
    Pvt.PivotFields("性別").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
    Pvt.PivotFields("年齢").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
    Pvt.PivotFields("誕生日").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
    Pvt.PivotFields("婚姻").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
    Pvt.PivotFields("都道府県").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
    Pvt.PivotFields("携帯").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
    Pvt.PivotFields("キャリア").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
    Pvt.PivotFields("カレーの食べ方").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
End Sub

全てのPivotFieldsに対し、同じ処理をしている。ここは、ループの出番だ。

Sub Macro2()
    Dim Pvt As Excel.PivotTable
    Set Pvt = ActiveSheet.PivotTables(1)
        Pvt.RowAxisLayout xlTabularRow
        
    Dim PvtField As Excel.PivotField
        For Each PvtField In Pvt.PivotFields
            PvtField.Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
        Next
End Sub

このままでも良いのだが、これを何とかしたい。

Array(False, False, False, False, False, False, False, False, False, False, False, False)

そこで、昨日の関数が登場する。

' content       配列に詰め込む値
' count_up      詰め込む値をカウントアップするか否か
' count_number  １回のカウントアップ量
' l_bound       インデックス番号の最小値
' u_bound       インデックス番号の最大値
Function DenseArray(content As Variant, _
                    Optional count_up As Boolean = False, _
                    Optional count_number As Long = 1, _
                    Optional l_bound As Long = 0, _
                    Optional u_bound As Long = 10) As Variant
          
    Dim arr() As Variant
    ReDim arr(l_bound To u_bound)
    Dim i As Long
        For i = l_bound To u_bound
            If count_up Then
                
                ' 数値でなければカウントアップできないので、ここで判別。
                If IsNumeric(content) Then
                    arr(i) = content + (i - 1) * count_number
                Else
                    arr(i) = content
                End If
            Else
                arr(i) = content
            End If
        Next
        DenseArray = arr
End Function

これを用いて、Falseを１２個詰め込んだ配列を作成し、コードに充ててみる。

Sub Macro2()
    Dim Pvt As Excel.PivotTable
    Set Pvt = ActiveSheet.PivotTables(1)
        Pvt.RowAxisLayout xlTabularRow
        
    Dim PvtArray() As Variant
        PvtArray = DenseArray(False, , , 0, 11)
        
    Dim PvtField As Excel.PivotField
        For Each PvtField In Pvt.PivotFields
            PvtField.Subtotals = PvtArray
        Next
End Sub

ということで、だいぶんスッキリした。
なお、配列一つをスッキリさせるためにユーザー定義関数を準備することの是非については、この際不問とする（議論が白熱しそうなので）。

参考まで。