VBA有字典结构吗?

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

328745 次浏览
小开

是的。对于VB6, VBA (Excel)和VB。网

小开
最佳答案

是的。

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

References Window

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

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 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日:更短的Contains()感谢@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

在我的一个项目中，我写了一组帮助函数，使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传递对象，而不用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

有

写这篇文章的原因是…

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

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

小开

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

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

而且它不会“大叫”;或“;complain"关于这个额外的步骤，“在引擎盖下”执行。当然，你可以显式地检查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

enter image description here

小开

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

哈希表

表示键/值对的集合

. key的哈希码

不确定你是否想在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的回答给出了大量关于哈希表的细节，以及为什么必须使用mscorlib.IEnumerable(早期对mscorlib的绑定引用)来枚举键:值对。


提交答案