VBA 有字典结构吗？

Question

VBA 有字典结构吗？ 像键<>值数组？

Answer 1

是的。

设置对 MS 脚本运行时（“Microsoft 脚本运行时”）的引用。 根据@regjo 的评论，转到“工具”->“参考”并勾选“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 

Answer 2

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() 。

Answer 3

VBA 没有字典的内部实现，但在 VBA 中，您仍然可以使用 MS Scripting Runtime Library 中的字典对象。

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

Answer 4

一个额外的字典示例，可用于包含出现频率。

循环外：

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

Answer 5

根据 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

---

对于我的一个项目，我编写了一组辅助函数来使Collection行为更像Dictionary 。 它仍然允许递归集合。 您会注意到 Key 总是排在第一位，因为它是强制性的，并且在我的实现中更有意义。 我也只使用了String键。 如果你愿意，你可以把它改回来。

放

我将其重命名为 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

得到

err是针对对象的，因为您将使用set和 variables 传递对象而不使用。 我想你可以检查它是否是一个对象，但我时间紧迫。

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

Answer 6

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

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

Answer 7

是的。 对于VB6 、VBA (Excel) 和VB.NET

Answer 8

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

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

它与 Microsoft 的版本相同。

Answer 9

如果出于任何原因，您无法为 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

Answer 10

您可以通过System.Collections.HashTable访问非本地HashTable 。

哈希表

表示基于键的哈希码组织的键/值对的集合。

不确定您是否想在Scripting.Dictionary上使用它，但为了完整起见，在此处添加。 如果有一些感兴趣的方法，例如Clone, 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.IEnumerable （对 mscorlib 的早期绑定引用）来枚举键：值对。

---

Answer 11

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

它的实现实际上是一个奇特的实现- 只需执行myDict(x) = y ，它就会检查字典中是否存在键x ，如果没有，它甚至会创建它。 如果它在那里，它使用它。

它不会“大喊”或“抱怨”这个额外的步骤，在“引擎盖下”执行。 当然，您可以使用Dictionary.Exists(key)明确检查键是否存在。 因此，这 5 行：

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