VBA中的哈希表/关联数组

Posted 2023-02-14

【中文标题】VBA中的哈希表/关联数组

【英文标题】：Hash Table/Associative Array in VBA

【发布时间】：2010-11-21 12:50:22

【问题描述】：

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

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

【问题讨论】：

Does VBA have Dictionary structure?的可能重复

Does VBA have Dictionary Structure?的可能重复

【参考方案1】：

我认为您正在寻找 Microsoft 脚本运行时库中的 Dictionary 对象。 （从 VBE 的 Tools...References 菜单中添加对项目的引用。）

它几乎适用于任何可以适合变体的简单值（键不能是数组，尝试将它们设为对象没有多大意义。请参阅下面@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

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

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

【讨论】：

是的 - 字典就是答案。我也在这个网站上找到了答案。 ***.com/questions/915317/…

这是一个很好的答案：但键永远不是对象——实际发生的是对象的默认属性被转换为字符串并用作键。如果对象没有定义默认属性（通常是“名称”），这将不起作用。

@Nile，谢谢。我看你确实是对的。看起来如果对象没有默认属性，那么对应的字典键是Empty。我相应地编辑了答案。

这里解释了几种数据结构-analystcave.com/…这篇文章展示了如何在 Excel VBA 中使用 .NEXT 哈希表-***.com/questions/8677949/…

以上链接错字：.NET，不是 .NEXT。

【参考方案2】：

我过去曾多次使用Francesco Balena's HashTable class，当时集合或字典并不完美，我只需要一个哈希表。

【参考方案3】：

尝试使用 Dictionary 对象或 Collection 对象。

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

【讨论】：

给定的链接不再起作用。可以在此处查看原始发布时的内容：web.archive.org/web/20090729034340/http://…

【参考方案4】：

我们开始...只需将代码复制到模块中，即可使用

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

在您的 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

【讨论】：

我不会对发布代码的全新用户投反对票，但通常称其为“哈希表”意味着底层实现实际上是一个哈希表！您在这里拥有的是一个使用常规数组和线性搜索实现的关联数组。看到这里的区别：en.wikipedia.org/wiki/Hash_table

确实如此。哈希表的要点是键的“散列”导致其值在底层存储中的位置（或至少足够接近，在允许重复键的情况下），因此无需进行潜在的昂贵搜索。

对于较大的哈希表来说太慢了。添加 17,000 个条目需要 15 秒以上。我可以使用字典在 6 秒内添加 500,000。使用 mscorlib 哈希表在 3 秒内完成 500,000 个。