在我向 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
【问题讨论】：
标签： vba collections
如果您打算使用默认的 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
【讨论】：
col1.add VBA.Array("first key", "first string"), "first key"，以避免由“Option Base 1”引起的不同下限。这样，结果数组的下限将始终为 0
如果不将键值存储在独立数组中，我认为使用 vanilla 集合是不可能的。
最简单的替代方法是添加对 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
【讨论】：
您可以创建一个小类来保存键和值，然后将该类的对象存储在集合中。
类键值：
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
这当然类似于字典建议，除了没有任何外部依赖。如果您想存储更多信息，可以根据需要使该类更复杂。
【讨论】：
另一种解决方案是将密钥存储在单独的集合中：
'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
您可以为键和值维护单独的排序顺序，这有时很有用。
【讨论】：
您可以使用 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
【讨论】：
您可以轻松地迭代您的收藏。下面的示例适用于特殊的 Access TempVars 集合，但适用于任何常规集合。
Dim tv As Long
For tv = 0 To TempVars.Count - 1
Debug.Print TempVars(tv).Name, TempVars(tv).Value
Next tv
【讨论】：