Dictionary Object - Complete demonstration

preview_player
Показать описание
This video gives a complete picture/ demonstration of the VBA Dictionary object starting from creation to deletion of all keys in it.
The below code has been used in this video. It as been explained and run line by line explaining code with the output.

Sub Dictionary_trial()
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'Create the dictionary object
Dim MyDict As New Scripting.Dictionary
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'Add values
MyDict.Add "Taj Mahal", "India.- Agra"
MyDict.Add "Chichen Itza", "Mexico.- Yucatán"
MyDict.Add "Christ the Redeemer", "Brazil.- Rio de Janeiro"
MyDict.Add "Colosseum", "Italy.- Rome"
MyDict.Add "Great Wall of China", "China"
MyDict.Add "Machu Picchu", "Cuzco Region"
MyDict.Add "Petra", "Jordan.-Ma'an Governorate"
MyDict.Add "Great Pyramid of Giza", "Egypt."
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'Using the count keyword to iterate

For n = 0 To MyDict.Count - 1
Debug.Print MyDict.Keys(n) & " " & MyDict.Items(n)
Next n
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'Changing some values
MyDict("Christ the Redeemer") = "Brazil"
MyDict("Petra") = "Jordan"
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'Iterating through all keys
For Each i In MyDict.Keys
Debug.Print i & " " & MyDict(i)
Next i
''+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'checking for existence of a key
If MyDict.Exists("Petra") Then
Debug.Print MyDict("Petra")
End If
Debug.Print MyDict.Exists("Petra")
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'Checking for existence of the same key with a different case
Debug.Print MyDict.Exists("petra")

'Removing all keys before changing comparemode
MyDict.RemoveAll

'Change compare mode and try again
MyDict.Comparemode = TextCompare

'Adding some data again
MyDict.Add "Taj Mahal", "India.- Agra"
MyDict.Add "Chichen Itza", "Mexico.- Yucatán"
MyDict.Add "Christ the Redeemer", "Brazil.- Rio de Janeiro"
MyDict.Add "Colosseum", "Italy.- Rome"
MyDict.Add "Great Wall of China", "China"
MyDict.Add "Machu Picchu", "Cuzco Region"
MyDict.Add "Petra", "Jordan.-Ma'an Governorate"
MyDict.Add "Great Pyramid of Giza", "Egypt."

'Verify if comparemode works
Debug.Print MyDict.Exists("petra")
''++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'Filtering the dictionary
For Each iter In Filter(MyDict.Keys, "Wall")
Debug.Print MyDict.Item(iter)
Next iter
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'Copying the dictionary to an array

' Declare variant to use as array
Dim arr As Variant

' Copy keys to array
arr = MyDict.Keys

' Print array to Immediate Window(Ctrl + G to View)
Call PrintArrayToImmediate(arr, "Keys:")

' Copy items to array
arr = MyDict.Items

' Print array to Immediate Window(Ctrl + G to View)
Call PrintArrayToImmediate(arr, "Items:")
''++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'Copy the list of items to the worksheet

'Into one cell
Sheets("Trial").Range("A1").Value = Join(MyDict.Keys, vbLf)

'In multiple rows
Range("B1").Resize(MyDict.Count, 1) = WorksheetFunction.Transpose(MyDict.Keys)
Range("C1").Resize(MyDict.Count, 1) = WorksheetFunction.Transpose(MyDict.Items)

'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'Removing one item
Debug.Print MyDict.Count
MyDict.Remove ("Petra")
Debug.Print MyDict.Count
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'Removing all items
MyDict.RemoveAll
Debug.Print MyDict.Count
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
End Sub
' Prints an array to the Immediate Window(Ctrl + G to View)
Sub PrintArrayToImmediate(arr As Variant, headerText As String)

Debug.Print vbNewLine & headerText
Dim entry As Variant
For Each entry In arr
Debug.Print entry
Next

End Sub
Рекомендации по теме