VBA有字典结构吗?比如key<>value array?


是的。适用于VB6, VBA (Excel), VB。网


Yes.

设置对MS脚本运行时('Microsoft脚本运行时')的引用。根据@regjo的评论,转到工具->参考,并勾选“微软脚本运行时”。

使用下面的代码创建一个字典实例:

Set dict = CreateObject("Scripting.Dictionary")

or

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

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

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


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。

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中安装额外的功能,您也可以使用数组,至少对于简单的问题。 你输入这个国家的名字,函数就会返回它的资本。

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总是排在前面,因为它是强制性的,在我的实现中更有意义。我也只使用字符串键。如果你愿意,你可以改回来。

Set

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

Get

err的东西是为对象,因为你会传递对象使用set和变量没有。我觉得你可以检查一下它是不是一个物体,但我时间很紧。

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

Has

写这篇文章的原因是…

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

Keys

获取一个键数组。

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

它与微软的版本完全相同。


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

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

而且它不会对这个“幕后”执行的额外步骤“大喊大叫”或“抱怨”。当然,您可以显式地使用Dictionary.Exists(key)检查键是否存在。因此,这5行:

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

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


你可以通过System.Collections.HashTable访问一个非本地哈希表。

哈希表

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

不确定你会想要使用这个脚本。字典,但在这里添加为完整起见。你可以回顾这些方法,如果有一些感兴趣的,例如克隆,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的引用),以便枚举键:值对。