VBA クラスモジュールを応用したサンプルコード①

■サンプルコード内容の図解
f:id:ray88:20210509125455p:plain

■サンプルコード
クラスモジュール（Customerクラスを利用してCustomersクラスを作成）

Option Explicit
'顧客情報セットのコレクション
Private myItems As Collection
'顧客情報IDをキーとしてコレクションの要素番号を紐づけるディクショナリ
Private myDictionary As Object

'変数の初期化
Private Sub Class_Initialize()
    Set myItems = New Collection
    Set myDictionary = CreateObject("Scripting.Dictionary")
End Sub

'変数の破棄
Private Sub Class_Terminate()
    Set myItems = Nothing
    Set myDictionary = Nothing
End Sub

'顧客情報を追加する
Public Sub Add(ByVal vID As String, ByVal vName As String, ByVal vAge As Integer, ByVal vGender As String)
    '顧客情報のセットであるCustomerクラスのオブジェクトを生成する
    Dim vCustomer As Customer
    Set vCustomer = New Customer
    
    'Customerオブジェクトに顧客情報を設定する
    With vCustomer
        .ID = vID
        .Name = vName
        .Age = vAge
        .Gender = vGender
    End With
    
    'コレクションに顧客情報セットを追加する
    myItems.Add vCustomer
    
    'Customerオブジェクトを初期化
    Set vCustomer = Nothing
    
    'ディクショナリに顧客情報のIDと顧客情報コレクションの総要素数を紐づけて格納
    myDictionary.Add Key:=vID, Item:=myItems.Count
    
End Sub

'顧客情報を取得する
Public Property Get Item(ByVal Index As Long) As Customer
    '顧客情報セットのコレクションmyItemよりアイテムのインデックス番号に紐づくデータを返す
    Set Item = myItems.Item(Index)
End Property

'顧客情報を検索する
Public Function SearchItemIndex(ByVal vID As String) As Variant
'-----------------------------------------------------
'機能：キー（対象ID）に紐づく値（インデックス番号）を返す
'引数1:対象ID
'戻り値：ディクショナリに対象IDが存在する場合は
'        IDに紐づく値（インデックス番号）を返す
'　　　　対象IDが存在しない場合は「False」を返す
'-----------------------------------------------------
    SearchItemIndex = False
    
    '対象IDがディクショナリのキーに存在する場合、キーに紐づく値（インデックス番号を返す）
    If myDictionary.Exists(vID) Then
        SearchItemIndex = myDictionary.Item(vID)
    End If
End Function

呼び出し元モジュール

Option Explicit
'表の列番号を定数化
Enum ColName
    ID = 1
    Name = 2
    Age = 3
    Gender = 4
End Enum
Sub 検索テスト()

    '表データを格納する変数
     Dim TableValue As Variant
    '表最終行格納用変数
    Dim lngLastRow As Long

    '表データをバリアント型配列に格納
    With Worksheets("Sheet2")
        .Select
       lngLastRow = .Cells(Rows.Count, 2).End(xlUp).Row
       TableValue = .Range(Cells(4, 2), Cells(lngLastRow, 5))
    End With
    
    '顧客情報のセットのコレクションであるCustomersクラスのオブジェクトを生成する
    Dim objCustomers As Customers
    Set objCustomers = New Customers
 
    '表データより顧客情報を取得しCustomerオブジェクトに値を設定
    Dim i As Long
    For i = LBound(TableValue) To UBound(TableValue)
            objCustomers.Add TableValue(i, ColName.ID), TableValue(i, ColName.Name), _
                             TableValue(i, ColName.Age), TableValue(i, ColName.Gender)
    Next
    
    'IDが「A0004」の顧客を検索する
    Dim vIndex As Variant
    
    vIndex = objCustomers.SearchItemIndex("A0004")
    If vIndex = False Then
        MsgBox "指定したIDは見つかりません", vbInformation
    Else
        Debug.Print objCustomers.Item(vIndex).Name
        Debug.Print objCustomers.Item(vIndex).Age
        Debug.Print objCustomers.Item(vIndex).Gender
    End If
    Set objCustomers = Nothing
End Sub