【Excel VBA】クラスモジュールでテーブルコレクションを作り、操作してみる

2025年1月29日 22:57

目的

テーブルからデータを抽出するのはもっぱら二次元配列を使うものだと思ってました。
何回も同じようなコードをテーブルの列数に合わせて作り変えるのはとても面倒だし、メンテナンス性も悪いと感じるようになった。
二次元配列に変わってコレクションを使ってテーブルデータを管理する方法（可読性、メンテナンス性、再利用性を重視）を考えてみる。

完成コード

テストデータ（動作検証用）

メインコード

Sub TestCode()
    
    'テーブルデータをコレクションに格納
    Dim TableData As Collection
    Set TableData = ExtractTableData(Sheet1.Range("A1:E11"))
    If TableData Is Nothing Then Exit Sub

    'コレクションからヘッダー名に該当するデータを二次元配列に取り出す
    Dim TBL As TableCollection: Set TBL = New TableCollection
    Dim LineData As Variant
    LineData = TBL.Get_DataList(TableData, "(1)")
    
    'コレクションからセル範囲を取り出す
    Dim LineRng As Range
    Set LineRng = TBL.Get_DataRange(TableData, "(1)")
    Debug.Print LineRng.Address(0, 0) 'B2:B11とイミディエイトウィンドウに表示される
    
End Sub

今回紹介するコードはテーブルヘッダーが一行目にあることを前提としています。列数は任意です（指定した列数（今回は5列）がコレクションに格納されます）

最初の二行でTableDataコレクションに指定したセル範囲のデータを格納できます。三行目はコレクションが取得できなかった時のエラー対応。
格納するための関数は【ExtractTableData】に記載されています。
それぞれの列のヘッダー名、セル範囲、データリストの三種類がひとつのコレクションに入ります。

テーブルヘッダー名からコレクションの数値リストを取り出すには、プロパティ【Get_DataList】で二次元配列【LineData】へ取り出せます。
第一引数はコレクションオブジェクト、第二引数はテーブルヘッダーの検索文字列です。"(1)"としているため、Line(1)の数値リストが取り出すことができます。

次にグラフなどでセル範囲を取り出したい場合は、同様にプロパティ【Get_DataRange】でRange型で取り出せます。
引数は、GetDataListと同じです。

ExtractTableData ファンクション

'**
'* テーブルデータをコレクションに格納する関数
'* 引数１：inRng {Range型}      コレクション化したいセル範囲
'* 戻り値：      {Collection型} コレクション
'**
Private Function ExtractTableData(ByVal inRng As Range) As Collection
    
    '入力確認
    If inRng.Rows.Count < 2 Then
        MsgBox "2行以上選択してください。", vbExclamation, "範囲選択エラー"
        Exit Function
    End If
    If VarType(inRng.Cells(1, 1)) <> vbString Then
        MsgBox "一行目は項目名（文字列）である必要があります。", vbExclamation, "範囲選択エラー"
        Exit Function
    End If
    
    '出力用のコレクション作成
    Dim Output As Collection: Set Output = New Collection
    
    ' ヘッダーごとに列データを取得
    Dim R As Long, C As Long
    For C = 1 To inRng.Columns.Count
        
        '個別列用コレクションの作成
        Dim BufData As TableCollection: Set BufData = New TableCollection
        
        'ヘッダーを格納
        BufData.In_Header = inRng.Cells(1, C).Value
        
        '列データ範囲を格納
        BufData.In_Range = inRng.Columns(C).Offset(1, 0).Resize(inRng.Rows.Count - 1, 1)
        
        '列データを格納
        For R = 2 To inRng.Rows.Count
            BufData.In_Data.Add inRng.Cells(R, C).Value
        Next R
        
        '出力用コレクションに追加
        Output.Add BufData
        
        '個別列用コレクションの初期化
        Set BufData = Nothing
        
    Next C
    
    '出力
    Set ExtractTableData = Output

End Function

TableCollection（クラスモジュール）

Option Explicit

Private Header_ As String
Private Range_ As Range
Private Data_ As Collection

'初期化
Private Sub Class_Initialize()
    Set Data_ = New Collection
End Sub

'テーブルヘッダーのプロパティ
Public Property Get In_Header() As String
    In_Header = Header_
End Property
Public Property Let In_Header(ByVal inTxt As String)
    Header_ = inTxt
End Property

'テーブルセル範囲のプロパティ
Public Property Get In_Range() As Range
    Set In_Range = Range_
End Property
Public Property Let In_Range(ByVal inRng As Range)
    Set Range_ = inRng
End Property

'テーブルデータのプロパティ
Public Property Get In_Data() As Collection
    Set In_Data = Data_
End Property
Public Property Set In_Data(ByVal Value As Collection)
    Set Data_ = Value
End Property


'ヘッダー文字列からデータリストを取り出す
Public Property Get Get_DataList(ByVal inCol As Collection, _
                                 ByVal inTxt As String) As Variant
    
    '処理
    Dim Output As Variant
    Dim Item As TableCollection
    For Each Item In inCol
        If Item.In_Header Like "*" & inTxt & "*" Then
            ReDim Output(1 To Item.In_Data.Count, 1 To 1)
            Dim Count As Long
            For Count = 1 To Item.In_Data.Count
                Output(Count, 1) = Item.In_Data(Count)
            Next Count
            Exit For
        End If
    Next Item
    
    '出力
    Get_DataList = Output
    
End Property


'ヘッダー文字列からセル範囲を取り出す
Public Property Get Get_DataRange(ByVal inCol As Collection, _
                                  ByVal inTxt As String) As Range
    
    '処理
    Dim Output As Range
    Dim Item As TableCollection
    For Each Item In inCol
        If Item.In_Header Like "*" & inTxt & "*" Then
            Set Output = Item.In_Range
            Exit For
        End If
    Next Item
    
    '出力
    Set Get_DataRange = Output
    
End Property

所感

このようにクラスモジュールを使い、コレクションからプロパティでデータを取り出すことができると、メインコードがすっきりわかりやすくなったと思います。

クラスモジュールを書く必要があり、コーディング量が増えるのはデメリットではあります。
しかし、一度書いてしまえば使い回しができるので、全体的なコード量は減るかもしれないと感じました。

このような書き方が正解なのかは素人なのでわかりませんが、こういった方法もあるということが知れたということが大きな成果かなと。
もっと良い書き方がないか、もう少し個人研究してみたいと思います。