レコードイメージのクラスへのコピー

クラスに楽にデータを入れたい

レコードイメージのクラスを良く使う。そのクラスの中にその固有の処理をカプセル化していけばいいのだ。しかし、外部との連携はDictionary等に比べると面倒な感じ。

Person クラス

Option Explicit

Public Name As String
Public Age As Long
Public Address As String

以下のようなテーブルを Person クラスに設定することを考えます。

ふつうに追加するとこんな感じ

Sub TableToPersonClass()
    
    'Person Class にコピー
    Dim col2 As Collection
    Set col2 = New Collection
    
    Dim c As Person
    Dim LO As ListObject
    Set LO = ActiveSheet.ListObjects(1)
    
    Dim i As Long
    Dim j As Long
    
    For i = 1 To LO.DataBodyRange.Rows.Count
            
        Set c = New Person
        'ベタに書くしかない
        c.Name = LO.DataBodyRange.Cells(i, 1).Value
        c.Age = LO.DataBodyRange.Cells(i, 2).Value
        c.Address = LO.DataBodyRange.Cells(i, 3).Value
    
        col2.Add c
    
    Next
    
    For Each c In col2
        Debug.Print c.Name
        Debug.Print c.Age
        Debug.Print c.Address
    Next
    
End Sub

列が増えればその分記入も増えて大変。このへんいつもめんどうだとおもっていました。

CallByNameの出番

今頃気が付きましたが、CallByName を使用すればシームレスに値のコピーが可能です。テーブルの列名を合わせておけば項目名を意識せずに処理可能です。

Sub TableToPersonClass()
    
    'Person Class にコピー
    Dim col2 As Collection
    Set col2 = New Collection
    
    Dim c As Person
    Dim LO As ListObject
    Set LO = ActiveSheet.ListObjects(1)
    
    Dim i As Long
    Dim j As Long
    
    For i = 1 To LO.DataBodyRange.Rows.Count
            
        Set c = New Person
        
        For j = 1 To LO.HeaderRowRange.Columns.Count
        
            'Person Class
            CallByName c, LO.HeaderRowRange(, j).Value, VbLet, LO.DataBodyRange.Cells(i, j).Value
        
        Next
    
        col2.Add c
    
    Next
    
    For Each c In col2
        Debug.Print c.Name
        Debug.Print c.Age
        Debug.Print c.Address
    Next
    
End Sub

Dictionaryからのシャローコピーにも使える。

Sub DictionaryToPerson()

    Dim dic As Scripting.Dictionary
    
    Set dic = New Scripting.Dictionary
    
    dic.Add "Name", "watanabe"
    dic.Add "Age", 48
    dic.Add "Address", "千葉県"
    
    Dim v As Variant
    Dim c As Person
    
    Set c = New Person
    
    For Each v In dic.Keys
        CallByName c, v, VbLet, dic.Item(v)
    Next

    Debug.Print c.Name
    Debug.Print c.Age
    Debug.Print c.Address

End Sub

JSONからのパースにも使えるのでデシリアライズがはかどる～