重くて有名な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 |