● Javaで言うところの HashMap クラス ●

重くて有名なCollectionをしぶしぶ使用している。作っては見たものの、やはり重かったので代用品を作成するに至ってしまったが、せっかく作ったので、ここにおいて置く。

Option Explicit

Private Const NO_DATA_EXISTS As Long = (-1)

Private KeyCollection As Collection
Private DataCollection As Collection

'---------------------------------------------------------------------------
' 機  能:初期処理
' 引  数:なし
' 返り値:なし
'---------------------------------------------------------------------------
Private Sub Class_Initialize()
    Set KeyCollection = New Collection
    Set DataCollection = New Collection
End Sub

'---------------------------------------------------------------------------
' 機  能:終了処理
' 引  数:なし
' 返り値:なし
'---------------------------------------------------------------------------
Private Sub Class_Terminate()
    Set KeyCollection = Nothing
    Set DataCollection = Nothing
End Sub

'---------------------------------------------------------------------------
' 機  能:値を追加する
' 引  数:Key  … キー
'         Data … 追加するデータ
' 返り値:なし
'---------------------------------------------------------------------------
Public Sub PutData(ByVal Key As String, ByVal Data As Variant)
    Dim ItemPos As Long

    '指定のキーデータが存在するか判定する
    ItemPos = KeyIndex(Key)

    'データが存在しない場合
    If ItemPos = NO_DATA_EXISTS Then
        Call KeyCollection.Add(Key, Key)
        Call DataCollection.Add(Data, Key)
    'データが存在する場合
    Else
        '1件のみ存在する
        If KeyCollection.count = 1 Then
            Call KeyCollection.Remove(1)
            Call DataCollection.Remove(1)
            Call PutData(Key, Data)
        '2件以上存在する
        Else
            '削除してから
            Call KeyCollection.Remove(ItemPos)
            Call DataCollection.Remove(ItemPos)
            '削除位置に追加する
            Call KeyCollection.Add(Key, Key, , ItemPos - 1)
            Call DataCollection.Add(Data, Key, , ItemPos - 1)
        End If
    End If
End Sub

'---------------------------------------------------------------------------
' 機  能:値を取得する
' 引  数:Key  … キー
' 返り値:取得した値
'---------------------------------------------------------------------------
Public Function GetData(ByVal Key As String) As Variant
    If ContainsKey(Key) Then GetData = DataCollection(Key)
End Function

'---------------------------------------------------------------------------
' 機  能:キーが存在するか判定する
' 引  数:Key … キー
' 返り値:存在する場合…True 存在しない場合…False
'---------------------------------------------------------------------------
Public Function ContainsKey(ByVal Key As String) As Boolean
    Dim ItemKey As Variant
    For Each ItemKey In KeyCollection
        If CStr(ItemKey) = Key Then
            ContainsKey = True
            Exit For
        End If
    Next ItemKey
End Function

'---------------------------------------------------------------------------
' 機  能:キーの存在位置を取得して返す
' 引  数:Key … キー
' 返り値:存在する場合は存在位置(1-Base)  存在しない場合…(-1)
'---------------------------------------------------------------------------
Public Function KeyIndex(ByVal Key As String) As Long
    KeyIndex = NO_DATA_EXISTS
    If KeyCollection.count = 0 Then Exit Function
    Dim i As Long
    Dim ItemKey As Variant
    For Each ItemKey In KeyCollection
        i = i + 1
        If CStr(ItemKey) = Key Then
            KeyIndex = i
            Exit For
        End If
    Next ItemKey
End Function

'---------------------------------------------------------------------------
' 機  能:すべてのキーと値を文字列化して返す
' 引  数:なし
' 返り値:すべてのキーと値の文字
'---------------------------------------------------------------------------
Public Function ToString() As String
    Dim i As Long
    For i = 1 To KeyCollection.count
        ToString = ToString + KeyCollection.Item(i) & ":" & DataCollection.Item(i) & vbCrLf
    Next i
End Function

戻る