web-dev-qa-db-ja.com

VBAコレクション：キーのリスト

VBAコレクションに値を追加した後、すべてのキーのリストを保持する方法はありますか？

例えば

Dim coll as new  Collection
Dim str1, str2, str3
str1="first string"
str2="second string"
str3="third string"
coll.add str1, "first key"
coll.add str2, "second key"
coll.add str3, "third key"

文字列のリストを保持する方法を知っています。

first string
second string
third string

もう一度：キーを保持する方法はありますか？

first key
second key
third key

注：AutoCAD 2007でVBAを使用しています

vbacollections
42
Artur Iwan

独立した配列にキー値を保存することなく、バニラコレクションでそれが可能になるとは思いません。

これを行う最も簡単な代替方法は、Microsoft Scripting Runtimeへの参照を追加し、代わりにより機能的な辞書を使用することです。

Dim dict As Dictionary
Set dict = New Dictionary

dict.Add "key1", "value1"
dict.Add "key2", "value2"

Dim key As Variant
For Each key In dict.Keys
    Debug.Print "Key: " & key, "Value: " & dict.Item(key)
Next
38
Alex K.

デフォルトのVB6 Collectionを使用する場合、最も簡単な方法は次のとおりです。

col1.add array("first key", "first string"), "first key"
col1.add array("second key", "second string"), "second key"
col1.add array("third key", "third string"), "third key"

次に、すべての値をリストできます。

Dim i As Variant

For Each i In col1
  Debug.Print i(1)
Next

またはすべてのキー：

Dim i As Variant

For Each i In col1
  Debug.Print i(0)
Next
40
GSerg

キーと値を保持する小さなクラスを作成し、そのクラスのオブジェクトをコレクションに保存できます。

クラスKeyValue：

Public key As String
Public value As String
Public Sub Init(k As String, v As String)
    key = k
    value = v
End Sub

それを使用するには：

Public Sub Test()
    Dim col As Collection, kv As KeyValue
    Set col = New Collection
    Store col, "first key", "first string"
    Store col, "second key", "second string"
    Store col, "third key", "third string"
    For Each kv In col
        Debug.Print kv.key, kv.value
    Next kv
End Sub

Private Sub Store(col As Collection, k As String, v As String)
    If (Contains(col, k)) Then
        Set kv = col(k)
        kv.value = v
    Else
        Set kv = New KeyValue
        kv.Init k, v
        col.Add kv, k
    End If
End Sub

Private Function Contains(col As Collection, key As String) As Boolean
    On Error GoTo NotFound
    Dim itm As Object
    Set itm = col(key)
    Contains = True
MyExit:
    Exit Function
NotFound:
    Contains = False
    Resume MyExit
End Function

これはもちろん、外部の依存関係がないことを除いて、辞書の提案に似ています。より多くの情報を保存する場合、必要に応じてクラスをより複雑にすることができます。

9
user895964

別の解決策は、キーを別のコレクションに保存することです。

'Initialise these somewhere.
Dim Keys As Collection, Values As Collection

'Add types for K and V as necessary.
Sub Add(K, V) 
Keys.Add K
Values.Add V, K
End Sub

キーと値の個別のソート順を維持できますが、これはときどき役立ちます。

8
Anonymous Coward

RTLMoveMemoryを使用してメモリ内をスヌープし、そこから目的の情報を直接取得できます。

32ビット：

Option Explicit

'Provide direct memory access:
Public Declare Sub MemCopy Lib "kernel32" Alias "RtlMoveMemory" ( _
    ByVal Destination As Long, _
    ByVal Source As Long, _
    ByVal Length As Long)


Function CollectionKeys(oColl As Collection) As String()

    'Declare Pointer- / Memory-Address-Variables
    Dim CollPtr As Long
    Dim KeyPtr As Long
    Dim ItemPtr As Long

    'Get MemoryAddress of Collection Object
    CollPtr = VBA.ObjPtr(oColl)

    'Peek ElementCount
    Dim ElementCount As Long
    ElementCount = PeekLong(CollPtr + 16)

        'Verify ElementCount
        If ElementCount <> oColl.Count Then
            'Something's wrong!
            Stop
        End If

    'Declare Simple Counter
    Dim index As Long

    'Declare Temporary Array to hold our keys
    Dim Temp() As String
    ReDim Temp(ElementCount)

    'Get MemoryAddress of first CollectionItem
    ItemPtr = PeekLong(CollPtr + 24)

    'Loop through all CollectionItems in Chain
    While Not ItemPtr = 0 And index < ElementCount

        'increment Index
        index = index + 1

        'Get MemoryAddress of Element-Key
        KeyPtr = PeekLong(ItemPtr + 16)

        'Peek Key and add to temporary array (if present)
        If KeyPtr <> 0 Then
           Temp(index) = PeekBSTR(KeyPtr)
        End If

        'Get MemoryAddress of next Element in Chain
        ItemPtr = PeekLong(ItemPtr + 24)

    Wend

    'Assign temporary array as Return-Value
    CollectionKeys = Temp

End Function


'Peek Long from given MemoryAddress
Public Function PeekLong(Address As Long) As Long

  If Address = 0 Then Stop
  Call MemCopy(VBA.VarPtr(PeekLong), Address, 4&)

End Function

'Peek String from given MemoryAddress
Public Function PeekBSTR(Address As Long) As String

    Dim Length As Long

    If Address = 0 Then Stop
    Length = PeekLong(Address - 4)

    PeekBSTR = Space(Length \ 2)
    Call MemCopy(VBA.StrPtr(PeekBSTR), Address, Length)

End Function

64ビット：

Option Explicit

'Provide direct memory access:
Public Declare PtrSafe Sub MemCopy Lib "kernel32" Alias "RtlMoveMemory" ( _
     ByVal Destination As LongPtr, _
     ByVal Source As LongPtr, _
     ByVal Length As LongPtr)



Function CollectionKeys(oColl As Collection) As String()

    'Declare Pointer- / Memory-Address-Variables
    Dim CollPtr As LongPtr
    Dim KeyPtr As LongPtr
    Dim ItemPtr As LongPtr

    'Get MemoryAddress of Collection Object
    CollPtr = VBA.ObjPtr(oColl)

    'Peek ElementCount
    Dim ElementCount As Long
    ElementCount = PeekLong(CollPtr + 28)

        'Verify ElementCount
        If ElementCount <> oColl.Count Then
            'Something's wrong!
            Stop
        End If

    'Declare Simple Counter
    Dim index As Long

    'Declare Temporary Array to hold our keys
    Dim Temp() As String
    ReDim Temp(ElementCount)

    'Get MemoryAddress of first CollectionItem
    ItemPtr = PeekLongLong(CollPtr + 40)

    'Loop through all CollectionItems in Chain
    While Not ItemPtr = 0 And index < ElementCount

        'increment Index
        index = index + 1

        'Get MemoryAddress of Element-Key
        KeyPtr = PeekLongLong(ItemPtr + 24)

        'Peek Key and add to temporary array (if present)
        If KeyPtr <> 0 Then
           Temp(index) = PeekBSTR(KeyPtr)
        End If

        'Get MemoryAddress of next Element in Chain
        ItemPtr = PeekLongLong(ItemPtr + 40)

    Wend

    'Assign temporary array as Return-Value
    CollectionKeys = Temp

End Function


'Peek Long from given Memory-Address
Public Function PeekLong(Address As LongPtr) As Long

  If Address = 0 Then Stop
  Call MemCopy(VBA.VarPtr(PeekLong), Address, 4^)

End Function

'Peek LongLong from given Memory Address
Public Function PeekLongLong(Address As LongPtr) As LongLong

  If Address = 0 Then Stop
  Call MemCopy(VBA.VarPtr(PeekLongLong), Address, 8^)

End Function

'Peek String from given MemoryAddress
Public Function PeekBSTR(Address As LongPtr) As String

    Dim Length As Long

    If Address = 0 Then Stop
    Length = PeekLong(Address - 4)

    PeekBSTR = Space(Length \ 2)
    Call MemCopy(VBA.StrPtr(PeekBSTR), Address, CLngLng(Length))

End Function
3
ChrisMercator

コレクションを簡単に反復できます。以下の例は、特別なAccess TempVarsコレクション用ですが、通常のコレクションで動作します。

Dim tv As Long
For tv = 0 To TempVars.Count - 1
    Debug.Print TempVars(tv).Name, TempVars(tv).Value
Next tv
0
Patrick Honorez