Excel VBA クラス コレクションの要素取得方法（Lv.13）

'標準モジュール
Sub rngCollectionTest()
  Dim table As clsCol
  'インスタンス作成⇒コンストラクタ起動
  Set table = New clsCol

  'この下の部分にサブルーチンを呼び出すコードを入れる
　'For Eachでコレクション内の要素毎にMsgBoxを表示する処理へ
  Call MsgBox_Element(table.mycol)

End Sub

'For Eachでコレクション内の要素毎にMsgBoxを表示する
Sub MsgBox_Element(ByVal Col As Collection)
  Dim c As Variant
  Dim i As Long
  For Each c In Col
    i = i + 1
    With c
      MsgBox "OWNER：" & .Name & "(" & .Age & "歳)" _
        & vbCrLf & "ペット名：" & .Pet.Name & _
        "(" & .Pet.Age & "歳)" & .Pet.Types & _
        "/" & .Pet.Gender, , _
        "Index=" & i & " , Key=" & .ID
    End With
  Next
End Sub

  '要素数をカウントしてMsgBoxを表示
  Dim i As Long
  For i = 1 To table.mycol.Count  'カウントした要素数をループ
    With table.mycol(i)
      MsgBox "OWNER：" & .Name & "(" & .Age & "歳)" _
        & vbCrLf & "ペット名：" & .Pet.Name & _
        "(" & .Pet.Age & "歳)" & .Pet.Types & _
        "/" & .Pet.Gender, , _
        "Index=" & i & " , Key=" & .ID
    End With
  Next

'KeyをInputBoxで指定し各プロパティをセルに書き込む
Sub GetKeyByInputBox(ByVal Col As Collection)
  Dim Elem As Object
  Dim Key As Long 'String
    
redo:
  Key = InputBox("取得するKeyのIndexを入力", "要素のKeyを指定")
  If Col.Count >= Key And Key > 0 Then
    Set Elem = Col.Item(Key)
    Cells(10, 1).Value = Elem.ID
    Cells(10, 2) = Elem.Name
    Cells(10, 3) = Elem.Age
    Cells(10, 4) = Elem.Pet.Name
    Cells(10, 5) = Elem.Pet.Age
    Cells(10, 6) = Elem.Pet.Types
    Cells(10, 7) = Elem.Pet.Gender
  Else
    MsgBox "存在しない Key が指定されました!": GoTo redo
  End If
End Sub

'Application.InputBoxで指定したKeyのセル横方向に書き込む
Sub GetKeyByAppInputBox(ByVal Col As Collection)
  Dim Elem As Object
  Dim rng As Range
  Dim Key As Variant
  Dim r As Long, c As Long, i As Long, x As Long
    
redo:
  On Error Resume Next
  Set rng = Application.InputBox( _
    Prompt:="指定するKeyのセルを選択してください", _
    Title:="セル（Key）選択", Type:=8)
  On Error GoTo 0
  If rng Is Nothing Then Exit Sub
  r = rng.Row     'セルの行番号
  c = rng.Column  'セルの列番号
  Key = rng.Value 'Key変数にセル値を代入
  x = Col.Count   '要素数カウント
  'Keyの存在確認をしてから処理する
  For i = 1 To x  'Keyが要素に存在するかチェック
    If Col.Item(i).ID = Key Then Exit For
  Next i
  If x + 1 >= i Then 'ループ内で抜けているかで分岐
    Set Elem = Col.Item(Key)
    Cells(r, c + 1) = Elem.Name
    Cells(r, c + 2) = Elem.Age
    Cells(r, c + 3) = Elem.Pet.Name
    Cells(r, c + 4) = Elem.Pet.Age
    Cells(r, c + 5) = Elem.Pet.Types
    Cells(r, c + 6) = Elem.Pet.Gender
  Else
    MsgBox "存在しない Key が指定されました!": GoTo redo
  End If
End Sub

Private Sub CommandButton1_Click()
  With ListBox1
    If .ListIndex = -1 Then
      '未選択の場合は何もしない
    Else
      SelectedKey = .List(.ListIndex, 0)
    End If
  End With
  Unload Me 'UserFormを閉じる
End Sub

'UserFormのリストからKeyを選択
Sub GetKeyByListBox(ByVal Col As Collection)
  Dim Elem As Object
  Dim Index As Long
  Dim ListBox As MSForms.ListBox
  Set ListBox = UserForm1.ListBox1
  'ListBoxにKeyリストを追加する
  For Index = 1 To Col.Count
    Set Elem = Col.Item(Index)
    ListBox.AddItem Elem.ID
  Next Index
  SelectedKey = ""  'Public変数初期化
  UserForm1.Show  'ユーザーフォームを表示
  If SelectedKey <> "" Then
    Set Elem = Col.Item(SelectedKey)
    Cells(10, 1).Value = Elem.ID
    Cells(10, 2) = Elem.Name
    Cells(10, 3) = Elem.Age
    Cells(10, 4) = Elem.Pet.Name
    Cells(10, 5) = Elem.Pet.Age
    Cells(10, 6) = Elem.Pet.Types
    Cells(10, 7) = Elem.Pet.Gender
  Else
    MsgBox "Key が選択されませんでした!"
  End If
End Sub