VBA 集合:键列表

声明:本页面是StackOverFlow热门问题的中英对照翻译,遵循CC BY-SA 4.0协议,如果您需要使用它,必须同样遵循CC BY-SA许可,注明原文地址和作者信息,同时你必须将它归于原作者(不是我):StackOverFlow 原文地址: http://stackoverflow.com/questions/5702362/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me): StackOverFlow

提示:将鼠标放在中文语句上可以显示对应的英文。显示中英文
时间:2020-09-08 11:23:09  来源:igfitidea点击:

VBA collection: list of keys

vbacollections

提问by Artur Iwan

After I add some values to the VBA collection, is there any way to retain the list of all keys?

在我向 VBA 集合添加一些值后,有没有办法保留所有键的列表?

For example

例如

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"

I know how to retain the list of strings:

我知道如何保留字符串列表:

first string
second string
third string

Once again: is there any way to retain the keys?

再说一遍:有没有办法保留钥匙?

first key
second key
third key

Note: I'm using VBA through AutoCAD 2007

注意:我通过 AutoCAD 2007 使用 VBA

采纳答案by Alex K.

I don't thinks that possible with a vanilla collection without storing the key values in an independent array.

我认为如果不将键值存储在独立数组中,香草集合是不可能的。

The easiest alternative to do this is to add a reference to the Microsoft Scripting Runtime& use a more capable Dictionary instead:

最简单的替代方法是添加对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

回答by GSerg

If you intend to use the default VB6 Collection, then the easiest you can do is:

如果您打算使用默认的 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"

Then you can list all values:

然后您可以列出所有值:

Dim i As Variant

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

Or all keys:

或所有键:

Dim i As Variant

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

回答by Alex K.

You can create a small class to hold the key and value, and then store objects of that class in the collection.

您可以创建一个小类来保存键和值,然后将该类的对象存储在集合中。

Class KeyValue:

类键值:

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

Then to use it:

然后使用它:

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

This is of course similar to the Dictionary suggestion, except without any external dependencies. The class can be made more complex as needed if you want to store more information.

这当然类似于 Dictionary 建议,除了没有任何外部依赖项。如果您想存储更多信息,可以根据需要使类变得更复杂。

回答by Anonymous Coward

An alternative solution is to store the keys in a separate Collection:

另一种解决方案是将密钥存储在单独的集合中:

'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

You can maintain a separate sort order for the keys and the values, which can be useful sometimes.

您可以为键和值维护单独的排序顺序,这有时很有用。

回答by ChrisMercator

You can snoop around in your memory using RTLMoveMemory and retrieve the desired information directly from there:

您可以使用 RTLMoveMemory 在您的内存中窥探并直接从那里检索所需的信息:

32-Bit:

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

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

回答by Patrick Honorez

You can easily iterate you collection. The example below is for the special Access TempVars collection, but works with any regular collection.

您可以轻松地迭代您的收藏。下面的示例适用于特殊的 Access TempVars 集合,但适用于任何常规集合。

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