Does VBA have dictionary structure? Like key<>value array?
011 Answers
Yes.
Set a reference to MS Scripting runtime ('Microsoft Scripting Runtime'). As per @regjo's comment, go to Tools->References and tick the box for 'Microsoft Scripting Runtime'.
Create a dictionary instance using the code below:
Set dict = CreateObject("Scripting.Dictionary")or
Dim dict As New Scripting.Dictionary Example of use:
If Not dict.Exists(key) Then dict.Add key, value
End If Don't forget to set the dictionary to Nothing when you have finished using it.
Set dict = Nothing 16 VBA has the collection object:
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")The Collection object performs key-based lookups using a hash so it's quick.
You can use a Contains() function to check whether a particular collection contains a key:
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 FunctionEdit 24 June 2015: Shorter Contains() thanks to @TWiStErRob.
Edit 25 September 2015: Added Err.Clear() thanks to @scipilot.
VBA does not have an internal implementation of a dictionary, but from VBA you can still use the dictionary object from 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 An additional dictionary example that is useful for containing frequency of occurence.
Outside of loop:
Dim dict As New Scripting.dictionary
Dim MyVar as StringWithin a loop:
'dictionary
If dict.Exists(MyVar) Then dict.Item(MyVar) = dict.Item(MyVar) + 1 'increment
Else dict.Item(MyVar) = 1 'set as 1st occurence
End IfTo check on frequency:
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 2 Building off cjrh's answer, we can build a Contains function requiring no labels (I don't like using labels).
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 FunctionFor a project of mine, I wrote a set of helper functions to make a Collection behave more like a Dictionary. It still allows recursive collections. You'll notice Key always comes first because it was mandatory and made more sense in my implementation. I also used only String keys. You can change it back if you like.
Set
I renamed this to set because it will overwrite old values.
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 SubGet
The err stuff is for objects since you would pass objects using set and variables without. I think you can just check if it's an object, but I was pressed for time.
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 FunctionHas
The reason for this post...
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 FunctionRemove
Doesn't throw if it doesn't exist. Just makes sure it's removed.
Private Sub cRemove(ByRef Col As Collection, Key As String) If cHas(Col, Key) Then Col.Remove Key
End SubKeys
Get an array of 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 The scripting runtime dictionary seems to have a bug that can ruin your design at advanced stages.
0If the dictionary value is an array, you cannot update values of elements contained in the array through a reference to the dictionary.
Yes. For VB6, VBA (Excel), and VB.NET
8All the others have already mentioned the use of the scripting.runtime version of the Dictionary class. If you are unable to use this DLL you can also use this version, simply add it to your code.
It is identical to Microsoft's version.
If by any reason, you can't install additional features to your Excel or don't want to, you can use arrays as well, at least for simple problems. As WhatIsCapital you put name of the country and the function returns you its capital.
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 1 VBA can use the dictionary structure of Scripting.Runtime.
And its implementation is actually a fancy one - just by doing myDict(x) = y, it checks whether there is a key x in the dictionary and if there is not such, it even creates it. If it is there, it uses it.
And it does not "yell" or "complain" about this extra step, performed "under the hood". Of course, you may check explicitly, whether a key exists with Dictionary.Exists(key). Thus, these 5 lines:
If myDict.exists("B") Then myDict("B") = myDict("B") + i * 3
Else myDict.Add "B", i * 3
End Ifare the same as this 1 liner - myDict("B") = myDict("B") + i * 3. Check it out:
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 You can access a non-Native HashTable through System.Collections.HashTable.
Represents a collection of key/value pairs that are organized based on the hash code of the key.
Not sure you would ever want to use this over Scripting.Dictionary but adding here for the sake of completeness. You can review the methods in case there are some of interest e.g. Clone, CopyTo
Example:
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 ' 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 SubThis answer by @MathieuGuindon gives plenty of detail about HashTable and also why it is necessary to use mscorlib.IEnumerable (early bound reference to mscorlib) in order to enumerate the key:value pairs.