vba VBA中的哈希表/关联数组

Hash Table/Associative Array in VBA

提问by Tyler

I can't seem to find the documentation explaining how to create a hash table or associative array in VBA. Is it even possible?

我似乎找不到解释如何在 VBA 中创建哈希表或关联数组的文档。甚至有可能吗？

Can you link to an article or better yet post the code?

你能链接到一篇文章还是更好地发布代码？

回答by jtolle

I think you are looking for the Dictionary object, found in the Microsoft Scripting Runtime library. (Add a reference to your project from the Tools...References menu in the VBE.)

我认为您正在寻找在 Microsoft Scripting Runtime 库中找到的 Dictionary 对象。（从 VBE 中的工具...引用菜单添加对您的项目的引用。）

It pretty much works with any simple value that can fit in a variant (Keys can't be arrays, and trying to make them objects doesn't make much sense. See comment from @Nile below.):

它几乎适用于任何可以适合变体的简单值（键不能是数组，并且试图使它们成为对象没有多大意义。请参阅下面来自@Nile 的评论。）：

Dim d As dictionary
Set d = New dictionary

d("x") = 42
d(42) = "forty-two"
d(CVErr(xlErrValue)) = "Excel #VALUE!"
Set d(101) = New Collection

You can also use the VBA Collection object if your needs are simpler and you just want string keys.

如果您的需求更简单并且只需要字符串键，您也可以使用 VBA 集合对象。

I don't know if either actually hashes on anything, so you might want to dig further if you need hashtable-like performance. (EDIT: Scripting.Dictionary does use a hash tableinternally.)

我不知道是否真的对任何东西进行了哈希处理，因此如果您需要类似哈希表的性能，您可能需要进一步挖掘。（编辑：Scripting.Dictionary 确实在内部使用了哈希表。）

回答by Mark Nold

I've used Francesco Balena's HashTable classseveral times in the past when a Collection or Dictionary wasn't a perfect fit and i just needed a HashTable.

我过去曾多次使用Francesco Balena 的 HashTable 类，当时集合或字典并不完美，我只需要一个 HashTable。

回答by Disco

Try using the Dictionary Object or the Collection Object.

尝试使用字典对象或集合对象。

http://visualbasic.ittoolbox.com/documents/dictionary-object-vs-collection-object-12196

http://visualbasic.ittoolbox.com/documents/dictionary-object-vs-collection-object-12196

回答by Stefan0410

Here we go... just copy the code to a module, it's ready to use

我们开始吧...只需将代码复制到一个模块中，它就可以使用了

Private Type hashtable
    key As Variant
    value As Variant
End Type

Private GetErrMsg As String

Private Function CreateHashTable(htable() As hashtable) As Boolean
    GetErrMsg = ""
    On Error GoTo CreateErr
        ReDim htable(0)
        CreateHashTable = True
    Exit Function

CreateErr:
    CreateHashTable = False
    GetErrMsg = Err.Description
End Function

Private Function AddValue(htable() As hashtable, key As Variant, value As Variant) As Long
    GetErrMsg = ""
    On Error GoTo AddErr
        Dim idx As Long
        idx = UBound(htable) + 1

        Dim htVal As hashtable
        htVal.key = key
        htVal.value = value

        Dim i As Long
        For i = 1 To UBound(htable)
            If htable(i).key = key Then Err.Raise 9999, , "Key [" & CStr(key) & "] is not unique"
        Next i

        ReDim Preserve htable(idx)

        htable(idx) = htVal
        AddValue = idx
    Exit Function

AddErr:
    AddValue = 0
    GetErrMsg = Err.Description
End Function

Private Function RemoveValue(htable() As hashtable, key As Variant) As Boolean
    GetErrMsg = ""
    On Error GoTo RemoveErr

        Dim i As Long, idx As Long
        Dim htTemp() As hashtable
        idx = 0

        For i = 1 To UBound(htable)
            If htable(i).key <> key And IsEmpty(htable(i).key) = False Then
                ReDim Preserve htTemp(idx)
                AddValue htTemp, htable(i).key, htable(i).value
                idx = idx + 1
            End If
        Next i

        If UBound(htable) = UBound(htTemp) Then Err.Raise 9998, , "Key [" & CStr(key) & "] not found"

        htable = htTemp
        RemoveValue = True
    Exit Function

RemoveErr:
    RemoveValue = False
    GetErrMsg = Err.Description
End Function

Private Function GetValue(htable() As hashtable, key As Variant) As Variant
    GetErrMsg = ""
    On Error GoTo GetValueErr
        Dim found As Boolean
        found = False

        For i = 1 To UBound(htable)
            If htable(i).key = key And IsEmpty(htable(i).key) = False Then
                GetValue = htable(i).value
                Exit Function
            End If
        Next i
        Err.Raise 9997, , "Key [" & CStr(key) & "] not found"

    Exit Function

GetValueErr:
    GetValue = ""
    GetErrMsg = Err.Description
End Function

Private Function GetValueCount(htable() As hashtable) As Long
    GetErrMsg = ""
    On Error GoTo GetValueCountErr
        GetValueCount = UBound(htable)
    Exit Function

GetValueCountErr:
    GetValueCount = 0
    GetErrMsg = Err.Description
End Function

To use in your VB(A) App:

要在您的 VB(A) 应用程序中使用：

Public Sub Test()
    Dim hashtbl() As hashtable
    Debug.Print "Create Hashtable: " & CreateHashTable(hashtbl)
    Debug.Print ""
    Debug.Print "ID Test   Add V1: " & AddValue(hashtbl, "Hallo_0", "Testwert 0")
    Debug.Print "ID Test   Add V2: " & AddValue(hashtbl, "Hallo_0", "Testwert 0")
    Debug.Print "ID Test 1 Add V1: " & AddValue(hashtbl, "Hallo.1", "Testwert 1")
    Debug.Print "ID Test 2 Add V1: " & AddValue(hashtbl, "Hallo-2", "Testwert 2")
    Debug.Print "ID Test 3 Add V1: " & AddValue(hashtbl, "Hallo 3", "Testwert 3")
    Debug.Print ""
    Debug.Print "Test 1 Removed V1: " & RemoveValue(hashtbl, "Hallo_1")
    Debug.Print "Test 1 Removed V2: " & RemoveValue(hashtbl, "Hallo_1")
    Debug.Print "Test 2 Removed V1: " & RemoveValue(hashtbl, "Hallo-2")
    Debug.Print ""
    Debug.Print "Value Test 3: " & CStr(GetValue(hashtbl, "Hallo 3"))
    Debug.Print "Value Test 1: " & CStr(GetValue(hashtbl, "Hallo_1"))
    Debug.Print ""
    Debug.Print "Hashtable Content:"

    For i = 1 To UBound(hashtbl)
        Debug.Print CStr(i) & ": " & CStr(hashtbl(i).key) & " - " & CStr(hashtbl(i).value)
    Next i

    Debug.Print ""
    Debug.Print "Count: " & CStr(GetValueCount(hashtbl))
End Sub