【ExcelVBA】クラス+Dictionary(Item複数)

ExcelVBA, クラスの操作

DictionaryオブジェクトのKeyは1つ、Itemは複数にする方法です。
配列とクラスも使います。下記図は、配列とDictionaryの関係イメージ図です。

イメージ図


配列に個人情報を入れておきます。
配列の要素数(0)は一意のワードです。このワードが、Dictionaryのキーになります。
配列の要素数(1)~(3)は、誰でも持っている個人情報です。(確定性)
配列の要素数(4)以降は、結婚して子供いる人は、子供の名前を入れます。(可変性)

子供は17人まで登録可能ですが、100人以上いる人は、Module3内に記述している、
ReDim Preserve ArrReg(20) を其れなりの要素数に増やしてください。

下記に記載したクラスとモジュールは、丸っとコピーして使用できます。
ただし、クラスオブジェクト名とモジュールオブジェクト名は、指定の場所にしてください。

参照設定

Dictionaryオブジェクトを使うため、Microsoft Scripting Runtime を 参照設定 で ON にします。
VBE画面「ツール」→「参照設定」

クラスオブジェクト名(Person3) の内容


Option Explicit

Public ID As String
Public 名前 As String
Public 誕生日 As Date
Public 血液型 As String
Private arrTmp() As String
 
Property Get 年齢() As Integer

    年齢 = DateDiff("yyyy", 誕生日, Date)
    
End Property

Property Get Self() As Person3

    Set Self = Me
    
End Property

Property Let 子供の名前(i As Long, value As String)

    ReDim Preserve arrTmp(i)
    arrTmp(i) = value

End Property

Property Get 子供の名前(i As Long) As String
    
    子供の名前 = arrTmp(i)

End Property


モジュールオブジェクト名(Module3) の内容

Option Explicit

Dim PersonDic As Object

Sub 登録実行()

    Set PersonDic = New Dictionary
    
    Dim ArrReg As Variant
    
    '新規登録(一人目)
    ArrReg = Array("PID001", "磯野波平", "1895/09/14", "A", "サザエ", "カツオ", "タラオ")
    Call PersonRegistration(ArrReg)
    
    '新規登録(二人目)
    ArrReg = Array("PID002", "さくら ひろし", "1934/06/20", "A", "さきこ", "ももこ")
    Call PersonRegistration(ArrReg)

    '一人目の登録内容更新(子供の名前を変更 タラオ→ワカメ)
    ArrReg = Array("PID001", "磯野波平", "1895/09/14", "A", "サザエ", "カツオ", "ワカメ")
    Call PersonRegistration(ArrReg)

    '上記で登録した二人のID検索
    Call ID検索("PID001")
    Call ID検索("PID002")

End Sub

Sub PersonRegistration(ByVal ArrReg As Variant)

    ReDim Preserve ArrReg(20)

    With New Person3
   
        If PersonDic.Exists(ArrReg(0)) = False Then
            '------------------------
            '新規登録
            '------------------------
            .ID = ArrReg(0)
            .名前 = ArrReg(1)
            .誕生日 = ArrReg(2)
            .血液型 = ArrReg(3)
            
            .子供の名前(0) = ArrReg(4)
            .子供の名前(1) = ArrReg(5)
            .子供の名前(2) = ArrReg(6)
            
            PersonDic.Add Key:=.ID, Item:=.Self
        Else
            '------------------------
            '更新
            '------------------------
            PersonDic(ArrReg(0)).名前 = ArrReg(1)
            PersonDic(ArrReg(0)).誕生日 = ArrReg(2)
            PersonDic(ArrReg(0)).血液型 = ArrReg(3)
            
            PersonDic(ArrReg(0)).子供の名前(0) = ArrReg(4)
            PersonDic(ArrReg(0)).子供の名前(1) = ArrReg(5)
            PersonDic(ArrReg(0)).子供の名前(2) = ArrReg(6)
        End If
    
    End With

End Sub

Sub ID検索(ByVal ID As String)

    If PersonDic.Exists(ID) = True Then

        Debug.Print "---------------------------------"
        Debug.Print "ID    :" & ID
        Debug.Print "名前  :" & PersonDic(ID).名前
        Debug.Print "誕生日:" & PersonDic(ID).誕生日
        Debug.Print "年齢  :" & PersonDic(ID).年齢
        Debug.Print "血液型:" & PersonDic(ID).血液型
        
        Debug.Print "子供1 :" & PersonDic(ID).子供の名前(0)
        Debug.Print "子供2 :" & PersonDic(ID).子供の名前(1)
        Debug.Print "子供3 :" & PersonDic(ID).子供の名前(2)
    
    End If

End Sub
※子供の名前は3人までの登録を前提にしています。
※20行目:磯野波平の「子供の名前3」をタラオからワカメに変更するデータです。

実行結果

---------------------------------
ID    :PID001
名前  :磯野波平
誕生日:1895/09/14
年齢  :125
血液型:A
子供1:サザエ
子供2:カツオ
子供3:ワカメ
---------------------------------
ID    :PID002
名前  :さくら ひろし
誕生日:1934/06/20
年齢  :86
血液型:A
子供1:さきこ
子供2:ももこ
子供3: