VBA有字典结构吗?比如key<>value array?
当前回答
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
其他回答
所有其他人都已经提到了Dictionary类的scripting.runtime版本的使用。如果您无法使用此DLL,您也可以使用此版本,只需将其添加到代码中。
https://github.com/VBA-tools/VBA-Dictionary/blob/master/Dictionary.cls
它与微软的版本完全相同。
脚本运行时字典似乎有一个bug,可能会在高级阶段破坏您的设计。
如果字典值是数组,则不能通过对字典的引用更新数组中包含的元素的值。
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
一个额外的字典示例,用于包含出现频率。
在循环外:
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
基于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