VBA 有字典结构吗？

是的。对于 VB6、VBA （Excel） 和 VB.NET

是的。

设置对 MS 脚本运行时（“Microsoft 脚本运行时”）的引用。根据 @regjo 的评论，转到 Tools->References 并勾选“Microsoft Scripting Runtime”框。

使用以下代码创建一个字典实例：

Set dict = CreateObject("Scripting.Dictionary")

或

Dim dict As New Scripting.Dictionary 

使用示例：

If Not dict.Exists(key) Then 
    dict.Add key, value
End If 

不要忘记将词典设置为使用完后。Nothing

Set dict = Nothing 

VBA 没有字典的内部实现，但从 VBA 中，您仍然可以使用 MS 脚本运行时库中的字典对象。

Dim d
Set d = CreateObject("Scripting.Dictionary")
d.Add "a", "aaa"
d.Add "b", "bbb"
d.Add "c", "ccc"

If d.Exists("c") Then
    MsgBox d("c")
End If

脚本运行时字典似乎有一个错误，可能会在高级阶段破坏您的设计。

如果字典值是数组，则无法通过对字典的引用来更新数组中包含的元素的值。

VBA 具有集合对象：

    Dim c As Collection
    Set c = New Collection
    c.Add "Data1", "Key1"
    c.Add "Data2", "Key2"
    c.Add "Data3", "Key3"
    'Insert data via key into cell A1
    Range("A1").Value = c.Item("Key2")

该对象使用哈希执行基于键的查找，因此速度很快。Collection

---

您可以使用函数来检查特定集合是否包含键：Contains()

Public Function Contains(col As Collection, key As Variant) As Boolean
    On Error Resume Next
    col(key) ' Just try it. If it fails, Err.Number will be nonzero.
    Contains = (Err.Number = 0)
    Err.Clear
End Function

编辑 2015 年 6 月 24 日：由于@TWiStErRob，更短。Contains()

编辑 2015 年 9 月 25 日：感谢 @scipilot。Err.Clear()

另一个字典示例，可用于包含发生频率。

循环外：

Dim dict As New Scripting.dictionary
Dim MyVar as String

在一个循环中：

'dictionary
If dict.Exists(MyVar) Then
    dict.Item(MyVar) = dict.Item(MyVar) + 1 'increment
Else
    dict.Item(MyVar) = 1 'set as 1st occurence
End If

要检查频率：

Dim i As Integer
For i = 0 To dict.Count - 1 ' lower index 0 (instead of 1)
    Debug.Print dict.Items(i) & " " & dict.Keys(i)
Next i

如果由于任何原因，您无法向 Excel 安装其他功能或不想安装其他功能，您也可以使用数组，至少对于简单的问题。 作为WhatIsCapital，您输入国家/地区的名称，该函数将返回其资本。

Sub arrays()
Dim WhatIsCapital As String, Country As Array, Capital As Array, Answer As String

WhatIsCapital = "Sweden"

Country = Array("UK", "Sweden", "Germany", "France")
Capital = Array("London", "Stockholm", "Berlin", "Paris")

For i = 0 To 10
    If WhatIsCapital = Country(i) Then Answer = Capital(i)
Next i

Debug.Print Answer

End Sub

基于 cjrh 的答案，我们可以构建一个不需要标签的 Contains 函数（我不喜欢使用标签）。

Public Function Contains(Col As Collection, Key As String) As Boolean
    Contains = True
    On Error Resume Next
        err.Clear
        Col (Key)
        If err.Number <> 0 Then
            Contains = False
            err.Clear
        End If
    On Error GoTo 0
End Function

---

对于我的一个项目，我编写了一组辅助函数，使行为更像 .它仍然允许递归收集。您会注意到 Key 始终排在第一位，因为它是强制性的，并且在我的实现中更有意义。我也只用了钥匙。如果您愿意，可以将其改回。CollectionDictionaryString

设置

我将其重命名为 set，因为它会覆盖旧值。

Private Sub cSet(ByRef Col As Collection, Key As String, Item As Variant)
    If (cHas(Col, Key)) Then Col.Remove Key
    Col.Add Array(Key, Item), Key
End Sub

获取

这些东西是针对对象的，因为你会传递对象 using 和 variables without out。我想你可以检查它是否是一个物体，但我的时间紧迫。errset

Private Function cGet(ByRef Col As Collection, Key As String) As Variant
    If Not cHas(Col, Key) Then Exit Function
    On Error Resume Next
        err.Clear
        Set cGet = Col(Key)(1)
        If err.Number = 13 Then
            err.Clear
            cGet = Col(Key)(1)
        End If
    On Error GoTo 0
    If err.Number <> 0 Then Call err.raise(err.Number, err.Source, err.Description, err.HelpFile, err.HelpContext)
End Function

有

这篇文章的原因...

Public Function cHas(Col As Collection, Key As String) As Boolean
    cHas = True
    On Error Resume Next
        err.Clear
        Col (Key)
        If err.Number <> 0 Then
            cHas = False
            err.Clear
        End If
    On Error GoTo 0
End Function

删除

如果它不存在，则不会抛出。只需确保它被删除即可。

Private Sub cRemove(ByRef Col As Collection, Key As String)
    If cHas(Col, Key) Then Col.Remove Key
End Sub

钥匙

获取密钥数组。

Private Function cKeys(ByRef Col As Collection) As String()
    Dim Initialized As Boolean
    Dim Keys() As String

    For Each Item In Col
        If Not Initialized Then
            ReDim Preserve Keys(0)
            Keys(UBound(Keys)) = Item(0)
            Initialized = True
        Else
            ReDim Preserve Keys(UBound(Keys) + 1)
            Keys(UBound(Keys)) = Item(0)
        End If
    Next Item

    cKeys = Keys
End Function

所有其他人都已经提到了 Dictionary 类的 scripting.runtime 版本的使用。如果您无法使用此 DLL，您也可以使用此版本，只需将其添加到您的代码中即可。

https://github.com/VBA-tools/VBA-Dictionary/blob/master/Dictionary.cls

它与Microsoft的版本相同。

VBA 可以使用 的字典结构。Scripting.Runtime

它的实现实际上是一个花哨的实现 - 只需这样做，它就会检查字典中是否有键，如果没有键，它甚至会创建它。如果它在那里，它就会使用它。myDict(x) = yx

而且它不会“大喊大叫”或“抱怨”这个额外的步骤，而是在“引擎盖下”执行。当然，您可以显式检查密钥是否存在 .因此，这 5 行：Dictionary.Exists(key)

If myDict.exists("B") Then
    myDict("B") = myDict("B") + i * 3
Else
    myDict.Add "B", i * 3
End If

与此 1 班轮相同 - .一探究竟：myDict("B") = myDict("B") + i * 3

Sub TestMe()

    Dim myDict As Object, i As Long, myKey As Variant
    Set myDict = CreateObject("Scripting.Dictionary")
    
    For i = 1 To 3
        Debug.Print myDict.Exists("A")
        myDict("A") = myDict("A") + i
        myDict("B") = myDict("B") + 5
    Next i
    
    For Each myKey In myDict.keys
        Debug.Print myKey; myDict(myKey)
    Next myKey

End Sub

您可以通过 访问非本机。HashTableSystem.Collections.HashTable

哈希表

表示键/值对的集合，这些键/值对基于 密钥的哈希代码。

不确定你是否想使用它，但为了完整起见，在这里添加。您可以查看这些方法，以防有一些感兴趣的方法，例如Scripting.DictionaryClone, CopyTo

例：

Option Explicit

Public Sub UsingHashTable()

    Dim h As Object
    Set h = CreateObject("System.Collections.HashTable")
   
    h.Add "A", 1
    ' h.Add "A", 1  ''<< Will throw duplicate key error
    h.Add "B", 2
    h("B") = 2
      
    Dim keys As mscorlib.IEnumerable 'Need to cast in order to enumerate  'https://stackoverflow.com/a/56705428/6241235
    
    Set keys = h.keys
    
    Dim k As Variant
    
    For Each k In keys
        Debug.Print k, h(k)                      'outputs the key and its associated value
    Next
    
End Sub

---

@MathieuGuindon的这个回答提供了大量关于 HashTable 的细节，以及为什么有必要使用（对 mscorlib 的早期绑定引用）来枚举键：值对。mscorlib.IEnumerable

---