Colección VBA: lista de claves

Después de agregar algunos valores a la colección de VBA, ¿hay alguna forma de conservar la lista de todas las claves?

Por ejemplo

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" 

Sé cómo mantener la lista de cadenas:

 first string second string third string 

Una vez más: ¿hay alguna forma de retener las llaves?

 first key second key third key 

Nota: estoy usando VBA a través de AutoCAD 2007

No creo que sea posible con una colección vainilla sin almacenar los valores clave en una matriz independiente. La alternativa más fácil para hacer esto es agregar una referencia al Microsoft Scripting Runtime y usar un diccionario más capaz en su lugar;

 Dim coll As New Dictionary ... Dim K As Variant For Each K In coll.Keys debug.print "Key: " & K , "Value: " & coll.Item(K) Next 

Si tiene la intención de utilizar la Collection VB6 predeterminada, lo más fácil que puede hacer es:

 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" 

Entonces puedes enumerar todos los valores:

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

O todas las llaves:

 Dim i As Variant For Each i In col1 Debug.Print i(0) Next 

Una solución alternativa es almacenar las claves en una Colección separada:

 '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 

Puede mantener un orden de clasificación por separado para las claves y los valores, que a veces puede ser útil.

Puede crear una clase pequeña para mantener la clave y el valor, y luego almacenar objetos de esa clase en la colección.

Clase KeyValue:

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

Entonces para usarlo:

 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 

Por supuesto, esto es similar a la sugerencia del diccionario, excepto que no hay dependencias externas. La clase puede hacerse más compleja según sea necesario si desea almacenar más información.

el problema es que para grandes conjuntos de datos, las colecciones funcionan mucho mejor que cualquier diccionario …

Puede husmear en su memoria usando RTLMoveMemory y recuperar la información deseada directamente desde allí:

32 bits:

 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 bits:

 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