クラスに楽にデータを入れたい
レコードイメージのクラスを良く使う。そのクラスの中にその固有の処理をカプセル化していけばいいのだ。しかし、外部との連携は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からのパースにも使えるのでデシリアライズがはかどる～