Vba excel dictionary пример - Word и Excel - помощь в работе с программами

Создание объекта Dictionary с помощью кода VBA Excel. Раннее и позднее связывание. Методы и свойства словаря и синтаксис выражений с ними. Примеры кода.

Dictionary – это объект, предназначенный для записи, хранения и использования пар, состоящих из ключа и элемента данных.

Раннее связывание:

Dim myDict As Dictionary

Set myDict = New Dictionary

или

Dim myDict As New Dictionary

Позднее связывание:

Dim myDict As Object

Set myDict = CreateObject(«Scripting.Dictionary»)

Чтобы использовать раннее связывание, необходимо подключить в редакторе VBA ссылку на библиотеку Microsoft Scripting Runtime, если она еще не подключена (в меню Tools–>References…):

Раннее связывание позволяет использовать при написании кода VBA Excel лист выбора и вставки свойств и методов объекта Dictionary (лист подсказок):

Лист подсказок отображается автоматически после ввода точки или, в иных случаях, вызывается сочетанием клавиш «Ctrl+Пробел».

Методы и свойства словаря

Методы объекта Dictionary

Метод Add
Метод Add добавляет в словарь новую пару ключ–элемент.

Dictionary.Add Ключ, Элемент

Ключ – обязательный аргумент, представляющий ключ добавляемой пары.
Элемент – обязательный аргумент, представляющий элемент добавляемой пары.

Если добавляемый ключ в словаре уже есть, VBA Excel сгенерирует ошибку.

Метод Exists
Метод Exists возвращает логическое значение, указывающее, существует ли в словаре указанный ключ. True – указанный ключ существует, False – указанный ключ не существует.

Метод Items
Метод Items возвращает массив всех элементов в словаре.

Метод Keys
Метод Keys возвращает массив всех ключей в словаре.

Метод Remove
Метод Remove удаляет из словаря одну пару ключ–элемент.

Если указанный ключ не существует, произойдет ошибка.

Метод RemoveAll
Метод RemoveAll удаляет из словаря все пары ключей и элементов.

Свойства объекта Dictionary

Свойство CompareMode
Свойство CompareMode задает или возвращает режим сравнения ключей в словаре. Используется для чтения и записи.

Dictionary.CompareMode [Сравнение]

Необязательный аргумент Сравнение используется только при записи и может принимать следующие значения:

–1 (vbUseCompareOption) – выполняется сравнение, заданное оператором Option Compare.
0 (vbBinaryCompare) – выполняется двоичное сравнение.
1 (vbTextCompare) – выполняется текстовое сравнение.

По умолчанию выполняется двоичное сравнение, при котором значение свойства CompareMode равно 0 (vbBinaryCompare).

Свойство Count
Свойство Count возвращает количество элементов в словаре. Только для чтения.

Свойство Item
Свойство Item задает или возвращает элемент для указанного ключа в словаре. Используется для чтения и записи.

Dictionary.Item(Ключ) [= Элемент]

Ключ – обязательный аргумент, представляющий из себя существующий ключ для чтения или изменения существующего элемента, или новый ключ для создания новой пары ключ–элемент.
Элемент – необязательный аргумент, представляющий выражение, которое заменяет существующий элемент с существующим ключом или добавляет новый элемент в пару ключ–элемент с новым ключом.

Если при создании с новым ключом новой пары ключ–элемент аргумент Элемент не указан, значение элемента будет пустым (Empty).

Свойство Key
Свойство Key задает новое значение ключа для существующего ключа в словаре.

Dictionary.Key(Ключ) = НовыйКлюч

Ключ – обязательный аргумент, представляющий из себя существующий ключ.
НовыйКлюч – обязательный аргумент, представляющий выражение, значение которого заменяет существующий ключ.

Если указанный ключ отсутствует в словаре, произойдет ошибка.

Примеры кода с Dictionary

Пример 1
Заполнение словаря парами ключ-элемент и извлечение элементов с помощью свойства Item:

Sub Primer1()

Dim myDict As New Dictionary

‘Добавляем три пары ключ-элемент

myDict.Add «№1», «Ананас»

myDict.Add 2, «Апельсин»

myDict.Add «Три», «Мандарин»

‘Смотрим количество записей в словаре

MsgBox myDict.Count

‘Извлекаем элементы по ключам

MsgBox myDict.Item(«№1»)

MsgBox myDict.Item(2)

MsgBox myDict.Item(«Три»)

End Sub

Пример 2
Замена элемента в существующей паре ключ-элемент, добавление новой пары ключ-элемент и добавление нового ключа без указания элемента с помощью свойства Item:

Sub Primer2()

Dim myDict As New Dictionary, _

i As Integer

‘Добавляем три пары ключ-элемент

myDict.Add 1, «Январь»

myDict.Add 2, «Вторник»

myDict.Add 3, «Среда»

‘Меняем элемент в паре с ключом 1

myDict.Item(1) = «Понедельник»

‘Добавляем новую пару ключ-элемент

myDict.Item(4) = «Четверг»

‘Извлекаем элементы по ключам

For i = 1 To 4

MsgBox myDict.Item(i)

‘Добавляем новый ключ без элемента,

‘MsgBox покажет пустую строку

MsgBox myDict.Item(5)

‘Убеждаемся, что теперь в словаре

‘не 4, а 5 записей

MsgBox myDict.Count

End Sub

Обратите внимание, добавить новый ключ без указания элемента можно только путем присвоения значения выражения переменной или, как во втором примере, функции MsgBox:

‘Так работает:

a = myDict.Item(НовыйКлюч)

‘Так работает:

MsgBox myDict.Item(НовыйКлюч)

‘Так не работает, вызывает ошибку:

myDict.Item(НовыйКлюч)

Пример 3
Извлечение ключей и элементов в массив:

Sub Primer3()

Dim myDict As New Dictionary, _

a As Variant, b As String, _

i As Integer

myDict.Add «з», «Зима»

myDict.Add «в», «Весна»

myDict.Add «л», «Лето»

myDict.Add «о», «Осень»

‘Извлекаем ключи в массив a

a = myDict.Keys

‘Записываем извлеченные ключи

‘в переменную b

b = «Ключи:» & vbNewLine

For i = 1 To myDict.Count

b = b & vbNewLine & a(i — 1)

‘Смотрим список ключей

MsgBox b

‘Извлекаем элементы в массив a

a = myDict.Items

‘Записываем извлеченные

‘элементы в переменную b

b = «Элементы:» & vbNewLine

For i = 1 To myDict.Count

b = b & vbNewLine & a(i — 1)

‘Смотрим список элементов

MsgBox b

End Sub

Источник

“The greatest masterpiece in literature is only a dictionary out of order.” – Jean Cocteau

A Quick Guide to the VBA Dictionary

Function	Example
Early binding reference	“Microsoft Scripting Runtime” (Add using Tools->References from the VB menu)
Declare (early binding)	Dim dict As Scripting.Dictionary
Create(early binding)	Set dict = New Scripting.Dictionary
Declare (late binding)	Dim dict As Object
Create(late binding)	Set dict = CreateObject(«Scripting.Dictionary»)
Add item (key must not already exist)	dict.Add Key, Value e.g. dict.Add «Apples», 50
Change value at key. Automatically adds if the key does not exist.	dict(Key) = Value e.g. dict(«Oranges») = 60
Get a value from the dictionary using the key	Value = dict(Key) e.g. appleCount = dict(«Apples»)
Check if key exists	dict.Exists(Key) e.g. If dict.Exists(«Apples») Then
Remove item	dict.Remove Key e.g. dict.Remove «Apples»
Remove all items	dict.RemoveAll
Go through all items (for each loop)	Dim key As Variant For Each key In dict.Keys Debug.Print key, dict(key) Next key
Go through all items (for loop — early binding only)	Dim i As Long For i = 0 To dict.Count — 1 Debug.Print dict.Keys(i), dict.Items(i) Next i
Go through all items (for loop — early and late binding)	Dim i As Long For i = 0 To dict.Count — 1 Debug.Print dict.Keys()(i), dict.Items()(i) Next i
Get the number of items	dict.Count
Make key case sensitive (the dictionary must be empty).	dict.CompareMode = vbBinaryCompare
Make key non case sensitive (the dictionary must be empty).	dict.CompareMode = vbTextCompare

What is the VBA Dictionary?

In VBA we use Arrays and Collections to store groups of values. For example, we could use them to store a list of customer names, student marks or a list of values from a range of cells.

A Dictionary is similar to a Collection. Using both types, we can name an item when we add it. Imagine we are storing the count of different fruit types.

We could use both a Collection and a Dictionary like this

' Add to Dictionary
dict.Add Key:="Apple", Item:=5

' Add to Collection
coll.Add Item:=5, Key:="Apple"

Example of Key, Value pairs

In both cases, we are storing the value 5 and giving it the name “Apple”. We can now get the value of Apple from both types like this

' Get value from Dictionary
Total = dict("Apple")

' Get value from Collection
Total = coll("Apple")

So far so good. The Collection however, has two major faults

We cannot check if the key already exists.
We cannot change the value of an existing item.

The first issue is pretty easy to get around: Check Collection Key exists. The second is more difficult.

The VBA Dictionary does not have these issues. You can check if a Key exists and you can change the Item and the Key.

For example, we can use the following code to check if we have an item called Apple.

If dict.Exists("Apple") Then 
    dict("Apple") = 78

These may seem very simple differences. However, it means that the Dictionary is very useful for certain tasks. Particularly when we need to retrieve the value of an item.

Download the Source Code

Dictionary Webinar

If you are a member of the VBA Vault, then click on the image below to access the webinar and the associated source code.

(Note: Website members have access to the full webinar archive.)

A Dictionary in real world terms

If you are still not clear about a Dictionary then think of it this way. A real-world dictionary has a list of keys and items. The Keys are the words and the Items are the definition.

When you want to find the definition of a word you go straight to that word. You don’t read through every item in the Dictionary.

A second real world example is a phone book(remember those?). The Key in a phone book is the nameaddress and the Item is the phone number. Again you use the nameaddress combination to quickly find a phone number.

In Excel the VLookup function works in a similar way to a Dictionary. You look up an item based on a unique value.

A Simple Example of using the VBA Dictionary

The code below give a simple but elegant example of using the Dictionary. It does the following

Adds three fruit types and a value for each to a Dictionary.
The user is asked to enter the name of a fruit.
The code checks if this fruit is in the Dictionary.
If yes then it displays the fruit name and the value.
If no then it informs the user the fruit does not exist.

' https://excelmacromastery.com/
Sub CheckFruit()

    ' Select Tools->References from the Visual Basic menu.
    ' Check box beside "Microsoft Scripting Runtime" in the list.
    Dim dict As New Scripting.Dictionary
    
    ' Add to fruit to Dictionary
    dict.Add key:="Apple", Item:=51
    dict.Add key:="Peach", Item:=34
    dict.Add key:="Plum", Item:=43

    Dim sFruit As String
    ' Ask user to enter fruit
    sFruit = InputBox("Please enter the name of a fruit")

    If dict.Exists(sFruit) Then
        MsgBox sFruit & " exists and has value " & dict(sFruit)
    Else
        MsgBox sFruit & " does not exist."
    End If
    
    Set dict = Nothing
    
End Sub

This is a simple example but it shows how useful a Dictionary is. We will see a real world example later in the post. Let’s look at the basics of using a Dictionary.

Creating a Dictionary

To use the Dictionary you need to first add the reference.

Select Tools->References from the Visual Basic menu.
Find Microsoft Scripting Runtime in the list and place a check in the box beside it.

We declare a dictionary as follows

Dim dict As New Scripting.Dictionary

Dim dict As Scripting.Dictionary
Set dict = New Scripting.Dictionary

Creating a Dictionary in this way is called “Early Binding”. There is also “Late Binding”. Let’s have a look at what this means.

Early versus Late Binding

To create a Dictionary using Late binding we use the following code. We don’t need to add a reference.

Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")

In technical terms Early binding means we decide exactly what we are using up front. With Late binding this decision is made when the application is running. In simple terms the difference is

Early binding requires a reference. Late binding doesn’t.
Early binding allows access to *Intellisense. Late binding doesn’t.
Early binding may require you to manually add the Reference to the “Microsoft Scripting Runtime” for some users.

(*Intellisense is the feature that shows you the available procedures and properties of an item as you are typing.)

While Microsoft recommends that you use early binding in almost all cases I would differ. A good rule of thumb is to use early binding when developing the code so that you have access to the Intellisense. Use late binding when distributing the code to other users to prevent various library conflict errors occurring.

Adding Items to the Dictionary

Function	Params	Example
Add	Key, Item	dict.Add «Apples», 50

We can add items to the dictionary using the Add function. Items can also be added by assigning a value which we will look at in the next section.

Let’s look at the Add function first. The Add function has two parameters: Key and Item. Both must be supplied

dict.Add Key:="Orange", Item:=45
dict.Add "Apple", 66
dict.Add "12/12/2015", "John"
dict.Add 1, 45.56

In the first add example above we use the parameter names. You don’t have to do this although it can be helpful when you are starting out.

The Key can be any data type. The Item can be any data type, an object, array, collection or even a dictionary. So you could have a Dictionary of Dictionaries, Array and Collections. But most of the time it will be a value(date, number or text).

If we add a Key that already exists in the Dictionary then we will get the error

The following code will give this error

dict.Add Key:="Orange", Item:=45

' This line gives an error as key exists already
dict.Add Key:="Orange", Item:=75

Assigning a Value

Operation	Format	Example
Assign	Dictionary(Key) = Item	dict(«Oranges») = 60

We can change the value of a key using the following code

dict("Orange") = 75

Assigning a value to Key this way has an extra feature. If the Key does not exist it automatically adds the Key and Item to the dictionary. This would be useful where you had a list of sorted items and only wanted the last entry for each one.

' Adds Orange to the dictionary 
dict("Orange") = 45 

' Changes the value of Orange to 100
dict("Orange") = 100

Don’t forget that you can download all the VBA code used in this post from the top or bottom of the post.

Checking if a Key Exists

Function	Parameters	Example
Exists	Key	If dict.Exists(«Apples») Then

We can use the Exists function to check if a key exists in the dictionary

' Checks for the key 'Orange' in the dictionary
If dict.Exists("Orange") Then
    MsgBox "The number of oranges is " & dict("Orange") 
Else
    MsgBox "There is no entry for Orange in the dictionary."
End If

Storing Multiple Values in One Key

Take a look at the sample data below. We want to store the Amount and Items for each Customer ID.

The Dictionary only stores one value so what can we do?

We could use an array or collection as the value but this is unnecessary. The best way to do it is to use a Class Module.

The following code shows how we can do this

' clsCustomer Class Module Code
Public CustomerID As String
Public Amount As Long
Public Items As Long

' Create a new clsCustomer object
Set oCust = New clsCustomer

' Set the values
oCust.CustomerID = rg.Cells(i, 1).Value
oCust.Amount = rg.Cells(i, 2).Value
oCust.Items = rg.Cells(i, 3).Value

' Add the new clsCustomer object to the dictionary
dict.Add oCust.CustomerID, oCust

You can see that by using the Class Module we can store as many fields as we want. Examples 2 and 3 at the bottom of the post show how to use a class module with a Dictionary

Other useful functions

Function	Parameters	Example
Count	N/A	dict.Count
Remove	Key	dict.Remove «Apples»
RemoveAll	N/A	dict.RemoveAll

The three functions in the above table do the following:

Count – returns the number of items in the Dictionary.
Remove – removes a given key from the Dictionary.
RemoveAll – removes all items from the Dictionary

The following sub shows an example of how you would use these functions

' https://excelmacromastery.com/
Sub AddRemoveCount()

    Dim dict As New Scripting.Dictionary

    ' Add some items
    dict.Add "Orange", 55
    dict.Add "Peach", 55
    dict.Add "Plum", 55
    Debug.Print "The number of items is " & dict.Count
    
    ' Remove one item
    dict.Remove "Orange"
    Debug.Print "The number of items is " & dict.Count
    
    ' Remove all items
    dict.RemoveAll
    Debug.Print "The number of items is " & dict.Count

End Sub

Remember that you can download all the code examples from the post. Just go to the download section at the top.

The Key and Case Sensitivity

Some of the string functions in VBA have a vbCompareMethod. This is used for functions that compare strings. It is used to determine if the case of the letters matter.

© BigStockPhoto.com

The Dictionary uses a similar method. The CompareMode property of the Dictionary is used to determine if the case of the key matters. The settings are

vbTextCompare: Upper and lower case are considered the same.

vbBinaryCompare: Upper and lower case are considered different. This is the default.

With the Dictionary we can use these settings to determine if the case of the key matters.

' https://excelmacromastery.com/
Sub CaseMatters()
    
    Dim dict As New Scripting.Dictionary
    dict.CompareMode = vbBinaryCompare
    dict.Add "Orange", 1
    
    ' Prints False because it considers Orange and ORANGE different 
    Debug.Print dict.Exists("ORANGE")    
    
    Set dict = Nothing

End Sub

This time we use vbTextCompare which means that the case does not matter

' https://excelmacromastery.com/
Sub CaseMattersNot()
    
    Dim dict As New Scripting.Dictionary
    dict.CompareMode = vbTextCompare
    dict.Add "Orange", 1
    
    ' Prints true because it considers Orange and ORANGE the same
    Debug.Print dict.Exists("ORANGE")    
    
    Set dict = Nothing

End Sub

Note: The Dictionary must be empty when you use the CompareMode property or you will get the error: “Invalid procedure call or argument”.

Things to Watch Out For

vbBinaryCompare (the case matters) is the default and this can lead to subtle errors. For example, imagine you have the following data in cells A1 to B2.

Orange, 5
orange, 12

The following code will create two keys – on for “Orange” and one for “orange”. This is subtle as the only difference is the case of the first letter.

' https://excelmacromastery.com/
Sub DiffCase()

    Dim dict As New Scripting.Dictionary
    
    dict.Add Key:=(Range("A1")), Item:=Range("B1")
    dict.Add Key:=(Range("A2")), Item:=Range("B2")

End Sub

If you do use vbTextCompare for the same data you will get an error when you try to add the second key as it considers “Orange” and “orange” the same.

' https://excelmacromastery.com/
Sub UseTextcompare()

    Dim dict As New Scripting.Dictionary
    dict.CompareMode = vbTextCompare
    
    dict.Add Key:=(Range("A1")), Item:=Range("B1")
    ' This line will give an error as your are trying to add the same key
    dict.Add Key:=(Range("A2")), Item:=Range("B2")

End Sub

If you use the assign method then it does not take the CompareMode into account. So the following code will still add two keys even though the CompareMode is set to vbTextCompare.

' https://excelmacromastery.com/
Sub Assign()
    
    Dim dict As New Scripting.Dictionary
    dict.CompareMode = vbTextCompare
    
    ' Adds two keys
    dict(Range("A1")) = Range("B1")
    dict(Range("A2")) = Range("B2")
    
    ' Prints 2
    Debug.Print dict.Count
    
End Sub

Reading through the Dictionary

We can read through all the items in the Dictionary. We can go through the keys using a For Each loop. We then use the current key to access an item.

Dim k As Variant
For Each k In dict.Keys
    ' Print key and value
    Debug.Print k, dict(k)
Next

We can also loop through the keys although this only works with Early Binding(Update Feb 2020: In Office 365 this now works with both versions):

Dim i As Long
For i = 0 To dict.Count - 1
    Debug.Print dict.Keys(i), dict.Items(i)
Next i

This method works with both Early and Late binding:

Dim i As Long
For i = 0 To dict.Count - 1
   Debug.Print dict.Keys()(i), dict.Items()(i)
Next i

Sorting the Dictionary

Sometimes you may wish to sort the Dictionary either by key or by value.

The Dictionary doesn’t have a sort function so you have to create your own. I have written two sort functions – one for sorting by key and one for sorting by value.

Sorting by keys

To sort the dictionary by the key you can use the SortDictionaryByKey function below

' https://excelmacromastery.com/
Public Function SortDictionaryByKey(dict As Object _
                  , Optional sortorder As XlSortOrder = xlAscending) As Object
    
    Dim arrList As Object
    Set arrList = CreateObject("System.Collections.ArrayList")
    
    ' Put keys in an ArrayList
    Dim key As Variant, coll As New Collection
    For Each key In dict
        arrList.Add key
    Next key
    
    ' Sort the keys
    arrList.Sort
    
    ' For descending order, reverse
    If sortorder = xlDescending Then
        arrList.Reverse
    End If
    
    ' Create new dictionary
    Dim dictNew As Object
    Set dictNew = CreateObject("Scripting.Dictionary")
    
    ' Read through the sorted keys and add to new dictionary
    For Each key In arrList
        dictNew.Add key, dict(key)
    Next key
    
    ' Clean up
    Set arrList = Nothing
    Set dict = Nothing
    
    ' Return the new dictionary
    Set SortDictionaryByKey = dictNew
        
End Function

The code below, shows you how to use SortDictionaryByKey

' https://excelmacromastery.com/
Sub TestSortByKey()

    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")
    
    dict.Add "Plum", 99
    dict.Add "Apple", 987
    dict.Add "Pear", 234
    dict.Add "Banana", 560
    dict.Add "Orange", 34
    
    PrintDictionary "Original", dict
    
    ' Sort Ascending
    Set dict = SortDictionaryByKey(dict)
    PrintDictionary "Key Ascending", dict
    
    ' Sort Descending
    Set dict = SortDictionaryByKey(dict, xlDescending)
    PrintDictionary "Key Descending", dict
    
End Sub

Public Sub PrintDictionary(ByVal sText As String, dict As Object)
    
    Debug.Print vbCrLf & sText & vbCrLf & String(Len(sText), "=")
    
    Dim key As Variant
    For Each key In dict.keys
        Debug.Print key, dict(key)
    Next
End Sub

Sorting by values

To sort the dictionary by the values you can use the SortDictionaryByValue function below.

' https://excelmacromastery.com/
Public Function SortDictionaryByValue(dict As Object _
                    , Optional sortorder As XlSortOrder = xlAscending) As Object
    
    On Error GoTo eh
    
    Dim arrayList As Object
    Set arrayList = CreateObject("System.Collections.ArrayList")
    
    Dim dictTemp As Object
    Set dictTemp = CreateObject("Scripting.Dictionary")
   
    ' Put values in ArrayList and sort
    ' Store values in tempDict with their keys as a collection
    Dim key As Variant, value As Variant, coll As Collection
    For Each key In dict
    
        value = dict(key)
        
        ' if the value doesn't exist in dict then add
        If dictTemp.exists(value) = False Then
            ' create collection to hold keys
            ' - needed for duplicate values
            Set coll = New Collection
            dictTemp.Add value, coll
            
            ' Add the value
            arrayList.Add value
            
        End If
        
        ' Add the current key to the collection
        dictTemp(value).Add key
    
    Next key
    
    ' Sort the value
    arrayList.Sort
    
    ' Reverse if descending
    If sortorder = xlDescending Then
        arrayList.Reverse
    End If
    
    dict.RemoveAll
    
    ' Read through the ArrayList and add the values and corresponding
    ' keys from the dictTemp
    Dim item As Variant
    For Each value In arrayList
        Set coll = dictTemp(value)
        For Each item In coll
            dict.Add item, value
        Next item
    Next value
    
    Set arrayList = Nothing
    
    ' Return the new dictionary
    Set SortDictionaryByValue = dict
        
Done:
    Exit Function
eh:
    If Err.Number = 450 Then
        Err.Raise vbObjectError + 100, "SortDictionaryByValue" _
                , "Cannot sort the dictionary if the value is an object"
    End If
End Function

The code below shows you how to use SortDictionaryByValue

' https://excelmacromastery.com/
Sub TestSortByValue()

    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")
    
    dict.Add "Plum", 99
    dict.Add "Apple", 987
    dict.Add "Pear", 234
    dict.Add "Banana", 560
    dict.Add "Orange", 34
    
    PrintDictionary "Original", dict
    
    ' Sort Ascending
    Set dict = SortDictionaryByValue(dict)
    PrintDictionary "Value Ascending", dict
    
    ' Sort Descending
    Set dict = SortDictionaryByValue(dict, xlDescending)
    PrintDictionary "Value Descending", dict
    
End Sub

Public Sub PrintDictionary(ByVal sText As String, dict As Object)
    
    Debug.Print vbCrLf & sText & vbCrLf & String(Len(sText), "=")
    
    Dim key As Variant
    For Each key In dict.keys
        Debug.Print key, dict(key)
    Next key
    
End Sub

Troubleshooting the Dictionary

This section covers the common errors you may encounter using the Dictionary.

Missing Reference

Issue: You get the error message “User-defined type not defined”
This normally happens when you create the Dictionary but forget to add the reference.

Dim dict As New Scripting.Dictionary

Resolution: Select Tools->Reference from the Visual Basic menu. Place a check in the box beside “Microsoft Scripting Runtime”.

See Section: Creating a Dictionary

Exists is not Working

Issue: You have added a key to the Dictionary but when you use the Exists function it returns false
This is normally an issue with Case Sensitivity(see above).
The following code adds “Apple” as a key. When we check for “apple” it returns false. This is because it takes the case of the letters into account:

dict.Add "Apple", 4

If dict.Exists("apple") Then
    MsgBox "Exists"
Else
    MsgBox "Does not Exist"
End If

You can set the CompareMode property to vbTextCompare and this will ignore the case:

Dim dict As New Scripting.Dictionary
dict.CompareMode = vbTextCompare

Resolution: Set the CompareMode to vbTextCompare to ignore case or ensure your data has the correct case.

See Section: The Key and Case Sensitivity

Object Variable Error

Issue: You get the error message “Object variable or With block variable not set” when you try to use the Dictionary.

The normally happens when you forget to use New before you use the Dictionary. For example, the following code will cause this error

Dim dict As Scripting.Dictionary
' This line will give "Object variable..." error
dict.Add "Apple", 4

Resolution: Use the New keyword when creating the Dictionary

Dim dict As New Scripting.Dictionary

Dim dict As Scripting.Dictionary
Set dict = New Scripting.Dictionary

See Section: Creating a Dictionary

Useful Tips for Troubleshooting the Dictionary

If you are investigating an issue with the Dictionary it can be useful to see the contents.

Use the following sub to Print each Key and Item to the Immediate Window(Ctrl + G).

' https://excelmacromastery.com/
Sub PrintContents(dict As Scripting.Dictionary)
    
    Dim k As Variant
    For Each k In dict.Keys
        ' Print key and value
        Debug.Print k, dict(k)
    Next

End Sub

You can use it like this

Dim dict As Scripting.Dictionary
Set dict = New Scripting.Dictionary

' Add items to Dictionary here

' Print the contents of the Dictionary to the Immediate Window
PrintContents dict

If you are stepping through the code you can also add dict.Count to the Watch Window to see how many items are currently in the Dictionary. Right-click anywhere in the code window and select Add Watch. Type dict.Count into the text box and click Ok.

You can also use the Dictionary itself as a Watch. Add Dict to the Watch window. If you click on the plus sign you will see the contents of the Dictionary. This can be useful but it only shows the key and not the item.

Note: You can only view Watches when the code is running.

Remember that you can download all the code examples from the post. Just go to the download section at the top.

Copying the Dictionary to an Array

As we know the dictionary is made up of Key and Value pairs. The dictionary has a Keys property which is an array of all the keys and an Items property which is an array of all the items(i.e. values).

As both of these properties are arrays, we can write them directly to a worksheet as we will see in the next section.

If we want to copy either the Keys or Items array to a new array then we can do it very easily like this:

Dim arr As Variant
arr = dict.Keys

The following example copies the Keys and Items arrays to new arrays. Then the contents of the new arrays are printed to the Immediate Window:

Sub DictionaryToArray()
    
    ' Create dictionary and add entries
    Dim dict As New Dictionary
    dict.Add "France", 56
    dict.Add "USA", 23
    dict.Add "Australia", 34

    ' Declare variant to use as array
    Dim arr As Variant

    ' Copy keys to array
    arr = dict.Keys
    ' Print array to Immediate Window(Ctrl + G to View)
    Call PrintArrayToImmediate(arr, "Keys:")
    
    ' Copy items to array
    arr = dict.Items
    ' Print array to Immediate Window(Ctrl + G to View)
    Call PrintArrayToImmediate(arr, "Items:")

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

When you run the code you wil get the following output:

Note that you can only copy the Items array when it contains basic data types like string, long, date, double etc. If the items are objects then you can not copy them to an array. You’ll need to read through the dictionary using a loop instead.

Writing the Dictionary to the Worksheet

We can write the Dictionary keys or items to the worksheet in one line of code.

When you write out the keys or items they will be written to a row. If you want to write them to a column you can use the WorksheetFunction.Transpose function.

The code below shows examples of how to write the Dictionary to a worksheet:

Sub DictionaryToWorksheet()
    
    Dim dict As New Dictionary
    
    dict.Add "France", 56
    dict.Add "USA", 23
    dict.Add "Australia", 34
    
    Dim sh As Worksheet
    Set sh = ThisWorkbook.Worksheets("Sheet1")
    
    ' Write keys to range A1:C1
    sh.Range("A1:C1").Value = dict.Keys
    
    ' Write items to range A2:C2
    sh.Range("A2:C2").Value = dict.Items
    
    ' Write keys to range E1:E3
    sh.Range("E1:E3").Value = WorksheetFunction.Transpose(dict.Keys)
    
    ' Write items to range F1:F3
    sh.Range("F1:F3").Value = WorksheetFunction.Transpose(dict.Items)

End Sub

Useful Dictionary Examples

The easiest way to see the benefits of the Dictionary is to see some real-world examples of it’s use. So in this section we are going to look at some examples. You can get workbooks and code for these examples by entering your email below:

Example 1 – Summing Single Values

Let’s have a look at a real-world example of using a dictionary. Our data for this example is the World Cup Final matches from 2014.

Our task here is to get the number of goals scored by each team.

The first thing we need to do is to read all the data. The following code reads through all the matches and prints the names of the two teams involved.

' https://excelmacromastery.com/vba-dictionary
' Reads the World Cup data from the 2014 Worksheet
' View the results in the Immediate Window(Ctrl + G)
Sub GetTotals()
    
    ' Get worksheet
    Dim wk As Worksheet
    Set wk = ThisWorkbook.Worksheets("2014")
    
    ' Get range for all the matches
    Dim rg As Range
    Set rg = wk.Range("A1").CurrentRegion
    
    Dim Team1 As String, Team2 As String
    Dim Goals1 As Long, Goals2 As Long

    Dim i As Long
    For i = 2 To rg.Rows.Count
        ' read the data from each match
        Team1 = rg.Cells(i, 5).Value
        Team2 = rg.Cells(i, 9).Value
        Goals1 = rg.Cells(i, 6).Value
        Goals2 = rg.Cells(i, 7).Value
        ' Print each teams/goals to Immediate Window(Ctrl + G)
        Debug.Print Team1, Team2, Goals1, Goals2
    Next i
    
End Sub

What we want to do now is to store each team and the goals they scored. When we meet a team for the first time we add the name as a Key and the number of goals as the Item.

Celebrating a Goal | © BigStockPhoto.com

If the team has already been added then we add the goals they scored in the current match to their total.

We can use the following line to add goals to the current team:

dict(Team1) = dict(Team1) + Goals1

This line is very powerful.

If the teams exists in the Dictionary, the current goals are added to the current total for that team.

If the team does not exist in the Dictionary then it will automatically add the team to the Dictionary and set the value to the goals.

For example, imagine the Dictionary has one entry

Key, Value
Brazil, 5

Then

dict("Brazil") = dict("Brazil") + 3

will update the dictionary so it now looks like this

Key, Value
Brazil, 8

The line

dict("France") = dict("France") + 3

will update the dictionary so it now looks like this

Key, Value
Brazil, 8
France, 3

This saves us having to write code like this:

If dict.Exists(Team1) Then
    ' If exists add to total
    dict(Team) = dict(Team) + Goals1
Else
    ' if doesn't exist then add
    dict(Team) = Goals1
End If

We write out the values from the Dictionary to the worksheet as follows:

' Write the data from the dictionary to the worksheet
' https://excelmacromastery.com/vba-dictionary
Private Sub WriteDictionary(dict As Scripting.Dictionary _
                    , shReport As Worksheet)

    ' Write the keys
    shReport.Range("A1").Resize(dict.Count, 1).Value = WorksheetFunction.Transpose(dict.Keys)
        
    ' Write the items
    shReport.Range("B1").Resize(dict.Count, 1).Value = WorksheetFunction.Transpose(dict.Items)
    
End Sub

We obviously want the scores to be sorted. It is much easier to read this way. There is no easy way to sort a Dictionary. The way to do it is to copy all the items to an array. Sort the array and copy the items back to a Dictionary.

What we can do is sort the data once it has been written to the worksheet. We can use the following code to do this:

' Sort the data on the worksheet
' https://excelmacromastery.com/vba-dictionary
Public Sub SortByScore(shReport As Worksheet _
                , Optional sortOrder As XlSortOrder = xlDescending)
    
    Dim rg As Range
    Set rg = shReport.Range("A1").CurrentRegion
    rg.Sort rg.Columns("B"), sortOrder
    
End Sub

Our final GetTotals sub looks like this:

' https://excelmacromastery.com/vba-dictionary
Sub GetTotalsFinal()
    
    ' Create dictionary
    Dim dict As New Scripting.Dictionary
    
    ' Get worksheet
    Dim sh As Worksheet
    Set sh = ThisWorkbook.Worksheets("2014")
    
    ' Get range
    Dim rgMatches As Range
    Set rgMatches = sh.Range("A1").CurrentRegion
    
    Dim team1 As String, team2 As String
    Dim goals1 As Long, goals2 As Long
    Dim i As Long
    
    ' Read through the range of data
    For i = 2 To rgMatches.Rows.Count
    
        ' read the data to variables
        team1 = rgMatches.Cells(i, 5).Value
        team2 = rgMatches.Cells(i, 9).Value
        goals1 = rgMatches.Cells(i, 6).Value
        goals2 = rgMatches.Cells(i, 7).Value
        
        ' Add the totals for each team to the dictionary.
        ' If the team doesn't exist it will be automatically added
        dict(team1) = dict(team1) + goals1
        dict(team2) = dict(team2) + goals2
        
    Next i
    
    ' Get the report worksheet
    Dim shReport As Worksheet
    Set shReport = ThisWorkbook.Worksheets("2014 Report")
    
    ' Write the teams and scores to the worksheet
    WriteDictionary dict, shReport
    
    ' Sort the range
    ' Change to xlAscending to reverse the order
    SortByScore shReport, xlDescending

    ' Clean up
    Set dict = Nothing
    
    shReport.Activate
        
End Sub

When you run this code you will get the following results

Teams ordered by number of goals scored

Example 2 – Dealing with Multiple Values

We are going to use the data from the Multiple Values section above

Imagine this data starts at cell A1. Then we can use the code below to read to the dictionary.

The code includes two subs for displaying the data:

WriteToImmediate prints the contents of the dictionary to the Immediate Window.
WriteToWorksheet writes the contents of the dictionary to the worksheet called Output.

To run this example:

Create a worksheet called Customers.
Add the above data to the worksheet starting at cell A1.
Create a worksheet called Output and leave it blank.
Go to the Visual Basic Editor(Alt + F11).
Select Tools->Reference and then check “Microsoft Scripting Runtime” from the list.
Create a new class module and add the first piece of code from below.
Create a new standard module and add the second piece of code from below.
Press F5 to run and select Main from the menu.
Check the ImmediateWindow(Ctrl + G) and the Output worksheet to see the results.

' clsCustomer Class Module Code
Public CustomerID As String
Public Amount As Long
Public Items As Long

' Standard module Code
' https://excelmacromastery.com/
Sub Main()

    Dim dict As Dictionary
    
    ' Read the data to the dictionary
    Set dict = ReadMultiItems
    
    ' Write the Dictionary contents to the Immediate Window(Ctrl + G)
    WriteToImmediate dict
    
    ' Write the Dictionary contents to a worksheet
    WriteToWorksheet dict, ThisWorkbook.Worksheets("Output")

End Sub

Private Function ReadMultiItems() As Dictionary

    ' Declare and create the Dictionary
    Dim dict As New Dictionary
    
    ' Get the worksheet
    Dim sh As Worksheet
    Set sh = ThisWorkbook.Worksheets("Customers")
    
    ' Get the range of all the adjacent data using CurrentRegion
    Dim rg As Range
    Set rg = sh.Range("A1").CurrentRegion

    Dim oCust As clsCustomer, i As Long
    ' read through the data
    For i = 2 To rg.Rows.Count
    
        ' Create a new clsCustomer object
        Set oCust = New clsCustomer
        
        ' Set the values
        oCust.CustomerID = rg.Cells(i, 1).Value
        oCust.Amount = rg.Cells(i, 2).Value
        oCust.Items = rg.Cells(i, 3).Value
        
        ' Add the new clsCustomer object to the dictionary
        dict.Add oCust.CustomerID, oCust
            
    Next i
    
    ' Return the dictionary to the Main sub
    Set ReadMultiItems = dict

End Function

' Write the Dictionary contents to the Immediate Window(Ctrl + G)
' https://excelmacromastery.com/
Private Sub WriteToImmediate(dict As Dictionary)
    
    Dim key As Variant, oCust As clsCustomer
    ' Read through the dictionary
    For Each key In dict.Keys
        Set oCust = dict(key)
        With oCust
            ' Write to the Immediate Window (Ctrl + G)
            Debug.Print .CustomerID, .Amount, .Items
        End With
        
    Next key
    
End Sub

' Write the Dictionary contents  to a worksheet
' https://excelmacromastery.com/
Private Sub WriteToWorksheet(dict As Dictionary, sh As Worksheet)
    
    ' Delete all existing data from the worksheet
    sh.Cells.ClearContents
    
    Dim row As Long
    row = 1
    
    Dim key As Variant, oCust As clsCustomer
    ' Read through the dictionary
    For Each key In dict.Keys
        Set oCust = dict(key)
        With oCust
            ' Write out the values
            sh.Cells(row, 1).Value = .CustomerID
            sh.Cells(row, 2).Value = .Amount
            sh.Cells(row, 3).Value = .Items
            row = row + 1
        End With
        
    Next key
    
End Sub

Example 3 – Summing Multiple Values

In this example were are going to make a small update to Example 2. In that example there was only one entry per customer in the data.

This time there will be multiple entries for some customers and we want to sum the total Amount and total Items for each customer.

See the updated dataset below:

Note: If you run the “Example 2” code on data with multiple copies of the CustomerID, it will give the “Key already exists error”.

' clsCustomer Class Module Code
Public CustomerID As String
Public Amount As Long
Public Items As Long

' Read from worksheet: CustomerSum
' Write to worksheet: CustomerRepSum
' https://excelmacromastery.com/vba-dictionary
Sub MainSum()

    Dim dict As Dictionary
    
    ' Read the data to the dictionary
    Set dict = ReadMultiItemsSum
    
    ' Write the Dictionary contents to the Immediate Window(Ctrl + G)
    WriteToImmediate dict
    
    ' Write the Dictionary contents to a worksheet
    WriteToWorksheet dict, ThisWorkbook.Worksheets("CustomerRepSum")
    
End Sub

' Read multiple items but this time sums the items
' https://excelmacromastery.com/
Private Function ReadMultiItemsSum() As Dictionary

    ' Declare and Create the Dictionary
    Dim dict As New Dictionary
    
    ' Get the worksheet
    Dim sh As Worksheet
    Set sh = ThisWorkbook.Worksheets("CustomerSum")
    
    ' Get the range of all the adjacent data using CurrentRegion
    Dim rg As Range
    Set rg = sh.Range("A1").CurrentRegion

    Dim oCust As clsCustomer, i As Long, customerID As String
    ' read through the data
    For i = 2 To rg.Rows.Count
        
        customerID = rg.Cells(i, 1).Value
        
        ' check if the customerID has been added already
        If dict.Exists(customerID) = True Then
            ' Get the existing customer object
            Set oCust = dict(customerID)
        Else
            ' Create a new clsCustomer object
            Set oCust = New clsCustomer
        
             ' Add the new clsCustomer object to the dictionary
            dict.Add customerID, oCust
        End If
        
        ' Set the values
        oCust.Amount = oCust.Amount + rg.Cells(i, 2).Value
        oCust.Items = oCust.Items + rg.Cells(i, 3).Value
            
    Next i
    
    ' Return the dictionary to the Main sub
    Set ReadMultiItemsSum = dict

End Function

' Write the Dictionary contents to the Immediate Window(Ctrl + G)
' https://excelmacromastery.com/vba-dictionary
Private Sub WriteToImmediate(dict As Dictionary)
    
    Dim key As Variant, oCust As clsCustomer
    ' Read through the dictionary
    For Each key In dict.Keys
        Set oCust = dict(key)
        With oCust
            ' Write to the Immediate Window (Ctrl + G)
            Debug.Print key, .Amount, .Items
        End With
        
    Next key
    
End Sub

' Write the Dictionary contents  to a worksheet
' https://excelmacromastery.com/
Private Sub WriteToWorksheet(dict As Dictionary, sh As Worksheet)
    
    ' Delete all existing data from the worksheet
    sh.Cells.ClearContents
    
    Dim row As Long
    row = 1
    
    Dim key As Variant, oCust As clsCustomer
    ' Read through the dictionary
    For Each key In dict.Keys
        Set oCust = dict(key)
        With oCust
            ' Write out the values
            sh.Cells(row, 1).Value = key
            sh.Cells(row, 2).Value = .Amount
            sh.Cells(row, 3).Value = .Items
            row = row + 1
        End With
        
    Next key
    
End Sub

When To Use The Dictionary

So when should you use the VBA Dictionary? When you have a task where:

You have a list of unique items e.g. countries, invoice numbers, customer name and addresses, project ids, product names etc.
You need to retrieve the value of a unique item.

Key/Values of Countries and Land area in Km²

What’s Next?

Free VBA Tutorial If you are new to VBA or you want to sharpen your existing VBA skills then why not try out the The Ultimate VBA Tutorial.

Related Training: Get full access to the Excel VBA training webinars and all the tutorials.

(NOTE: Planning to build or manage a VBA Application? Learn how to build 10 Excel VBA applications from scratch.)

Источник

Содержание:

1. Что такое Dictionary?

2. Создание Dictionary

3. Свойства и методы объекта Dictionary

4. Наполнение словаря

4.1. Типы данных ключа и элемента

4.2. Через метод Add

4.3. Через свойство Item

4.4. Неявное добавление ключа в Dictionary

5. Удаление элементов

5.1. Удаление конкретного элемента

5.2. Очистка всего словаря

6. Ключи

6.1. Последовательность хранения

6.2. Добавление элементов с ключами разных типов

6.3. Уникальность строковых ключей

6.4. Генерация уникальных ключей

7. Элементы

7.1. Типы элементов

7.2. UDT

8. Доступ к элементам словаря

8.1. Извлечение элемента по ключу

8.2. Извлечение элемента по номеру его индекса

8.3. Извлечение ключа по номеру его индекса

9. Перебор словаря

9.1. For each по массивам Keys и Items

9.2. For по массивам Keys и Items

9.3. Фильтрация элементов

9.4. Выгрузка словаря в диапазон ячеек

9.5. Операции с ключами/элементами при помощи формул рабочего листа

10. Файл примера

11. Заключение

12. Использованный источник

Если вы программируете на VBA/VBS, то рано или поздно вынуждены будете познакомиться с объектом Dictionary. Если в двух словах, то Dictionary — это продвинутый массив. Как вы знаете, массив — это упорядоченный набор неких (обычно однородных) элементов. Вот типичный массив:

Элементы пронумерованы и доступны по номеру индекса. Индекс всегда числовой.

А вот, что из себя представляет Dictionary (словарь):

Как видите, каждому элементу поставлен в соответствие не просто числовой индекс, а уникальный ключ, который в данном случае представляет из себя текстовую строку (имена). Двух одинаковых ключей в словаре быть не может, но могут быть одинаковые элементы (хоть все одинаковые). Таким образом словарь — это обычно некий список, снабжённый ключом, при помощи которого вы хотите извлекать полезную информацию (элементы). В указанном примере мы имеем, допустим, имена детей в качестве ключа, а в качестве элементов, поставленных в соответствие ключу, скажем, количество карманных денег у ребёнка.

С другой стороны нечто подобное можно же сделать, используя массив. Давайте объявим двумерный массив:

Должно быть у словаря есть какие-то преимущества перед таким использованием массивов? И это действительно так!

Давайте пока просто перечислим важнейшие преимущества:

Словарь контролирует уникальность ключей. Два одинаковых ключа не могут быть добавлены в словарь. Это важное свойство, так как программисту очень часто требуется обеспечить или проконтролировать уникальность каких-либо наборов значений, и в этом может с успехом быть использован Dictionary;
Словарь очень эффективно (при помощи встроенного алгоритма бинарного поиска) осуществляет извлечение элементов по известному ключу. В десятки раз быстрее, чем обычный перебор;
У словаря есть встроенный метод (Exists), при помощи которого можно понять, добавлен ли некий ключ в коллекцию;
Словарь позволяет добавлять новые элементы и удалять любые элементы, что, работая с массивами, сделать гораздо сложнее;
Словарь может вернуть все ключи и все элементы в виде отдельных одномерных массивов.

▲ вверх

2. Создание Dictionary

Существует несколько способов создать объект типа Dictionary. Ознакомимся с ними:

Считается, что методы, использующие позднее связывание надёжнее в плане обеспечения работоспособности программы на разных компьютерах, так как не зависят от настроек Tools — References… редактора VBA.

Однако, учитывая, что библиотека Microsoft Scripting Runtime присутствует везде, начиная с Windows 2000, я думаю, что вы без какого-либо ущерба можете использовать методы раннего связывания. Раннее связывание хорошо тем, что оно несколько быстрее работает, а также во время разработки вы можете пользоваться функцией завершения кода (когда среда программирования вам подсказывает имеющиеся у объекта свойства и методы). Выбор за вами.

▲ вверх

3. Свойства и методы объекта Dictionary

Тип	Идентификатор	Описание
Свойство	Count	dicObject.Count Возвращает количество элементов в словаре. Только для чтения.
Свойство	Item	dicObject.Item(key)[ = newitem] Устанавливает или возвращает элемент с указанным ключом. Чтение/запись.
Свойство	Key	dicObject.Key(key) = newkey Заменяет ключ элемента на новое значение.
Свойство	CompareMode	dicObject.CompareMode[ = compare] Устанавливает и возвращает режим сравнения текстовых ключей в словаре. Чтение/запись.
Метод	Add	dicObject.Add (key, item) Добавляет пару ключ-элемент в словарь.
Метод	Exists	dicObject.Exists(key) Возвращает true, если указанный ключ существует в словаре, либо false — в противном случае.
Метод	Items	dicObject.Items( ) Возвращает массив, состоящий из всех элементов, имеющихся в коллекции.
Метод	Keys	dicObject.Keys( ) Возвращает массив, состоящий из всех ключей, имеющихся в коллекции.
Метод	Remove	dicObject.Remove(key) Удаляет из словаря элемент с указанным ключом.
Метод	RemoveAll	dicObject.RemoveAll( ) Полностью очищает словарь от элементов. Сам объект словаря при этом не уничтожается.

▲ вверх

4. Наполнение словаря

4.1. Типы данных ключа и элемента

Dictionary наполняется по одному элементу. Не существует способов наполнить словарь массово. Чтобы добавить в словарь новый элемент вы должны иметь уникальный ключ и сам элемент, который под этим ключом будет храниться в словаре.

В качестве типа данных для элемента может быть использовано практически всё что угодно: числа, логический тип, строки (в том числе пустые), дата-время, массивы, любые объекты (листы, диапазоны, коллекции, другие словари, пустой указатель Nothing).

В качестве типа данных для ключа могут быть использованы: числа, строки, дата-время, объекты, но не массивы.

UDT (User Defined Type) не может напрямую использоваться в качестве ключа и/или элемента, но данное ограничение можно обойти, объявив аналог UDT, создав класс и определив в нём свойства аналогичные имеющимся в UDT. А поскольку класс — это объектный тип, то его уже можно использовать для ключей и элементов.

▲ вверх

4.2. Через метод Add

На листе Example, прилагаемого к статье файла, есть таблица с TOP30 стран по площади их территории. Для области данных этой таблицы объявлен именованный диапазон SquareByCountry. Пример ниже добавляет все строки указанногот ИД в Dictionary по принципу страна (key) — площадь (item):

Как видите, для добавления элемента (item) мы в 12-й строке кода использовали метод Add объекта dicCountry. Если в нашей таблице будет задвоена страна, то при попытке добавить в словарь элемента с ключом, который в словаре уже есть, будет сгенерировано исключение:

▲ вверх

4.3. Через свойство Item

Используя свойство Item, также можно добавлять пары ключ-элемент, однако, при попытке добавить дублирующий ключ исключения сгенерировано НЕ БУДЕТ, а элемент будет заменён на новый (с потерей старого). Это очень полезно — иметь возможность выбирать способы наполнения словаря, отличающиеся реакцией на задвоение ключей.

▲ вверх

4.4. Неявное добавление ключа в Dictionary

И ещё один неожиданный и я бы сказал экзотический способ пополнения словаря. Если упомянуть свойство Item по ПРАВУЮ сторону оператора присваивания, то он оказывается добавит в словарь key с пустым item, если данного key не существует в коллекции. Если же такой key уже существует, то никаких действий предпринято не будет.

Ещё раз хочу обратить ваше внимание, что элемент (item) при таком пополнении коллекции будет пустым (Empty). Это можно использовать, если вам нет необходимости что-то хранить в элементах в качестве полезной нагрузки (например, когда вы просто строите список уникальных значений, встречающихся в столбце таблицы).

Если вы читаете словарь через Item (а это, собственно, самый логичный и распространенный метод), и при этом хотите избежать добавления пустых ключей в словарь, используйте предварительно метод Exists, что контроля наличия такого ключа в коллекции.

▲ вверх

5. Удаление элементов

Есть 2 варианта удаления элементов из словаря:

5.1. Удаление конкретного элемента

▲ вверх

5.2. Очистка всего словаря

Полагаю, комментировать тут нечего.

▲ вверх

6. Ключи

6.1. Последовательность хранения

Следует понимать, что элементы в словаре хранятся в той последовательности, в которой они добавлялись в словарь. Менять эту последовательность можно только путём полной перестройки словаря (хотя не совсем понятно для чего это может понадобиться).

▲ вверх

6.2. Добавление элементов с ключами разных типов

Продемонстрируем, добавление элементов с ключами разных типов в словарь:

Вот, что мы получим, выполнив представленный код:

▲ вверх

6.3. Уникальность строковых ключей

При помощи свойства CompareMode можно управлять тем, как Dictionary будет реагировать на одинаковые текстовые ключи, набранные в разном регистре. При значении CompareMode равным константе TextCompare (1) разный регистр игнорируется и ключи считаются идентичными, а при константе BinaryCompare (0) такие ключи считаются разными. Менять CompareMode можно только, когда словарь пуст (либо только создан, либо только что очищен).

▲ вверх

6.4. Генерация уникальных ключей

Иногда требуется сохранить в Dictionary все элементы, а какие при этом будут ключи нам всё равно — лишь бы они были уникальные, так как в противном случае мы можем потерять некоторые элементы (items). В таких случаях очень удобно использовать свойство Count в качестве генератора уникального значения ключа, так как Count гарантированно увеличивается на единицу всякий раз, когда добавляется элемент.

▲ вверх

7. Элементы

7.1. Типы элементов

Продемонстрируем добавление в словарь элементов разных типов:

▲ вверх

7.2. UDT

Как я уже упоминал, напрямую переменные типа UDT нельзя сохранять в качестве элементов Dictionary. Чтобы это обойти нужно вместо UDT создать модуль класса, полностью соответствующий структуре необходимого вам UDT. Например, я создал модуль класса с названием MyRGB и определил его так:

далее становится возможным следующее:

▲ вверх

8. Доступ к элементам словаря

8.1. Извлечение элемента по ключу

Этот способ мы уже обсуждали, но для полноты картины повторимся.

Мы используем свойство Item с указанием ключа. Если ключа не существует, то будет возвращено значение Empty, а в словарь добавлен данный ключ со значением Empty в качестве элемента. Никаких исключений не генерируется. Если хотите избежать добавления ключа в коллекцию, используйте предварительно метод Exists для проверки его наличия.

▲ вверх

8.2. Извлечение элемента по номеру его индекса

Для извлечения конкретного элемента по его индексу необходимо использовать конструкцию Items()(i), где i — индекс элемента, начинающийся с нуля. Это довольно неожиданный синтаксис, я не припомню, чтобы он применялся где-то ещё кроме Dictionary. Согласно таблице, приведенной выше, Items — свойство, содержащее одномерный массив всех элементов словаря. Также есть соответствующий массив Keys для всех ключей словаря.

▲ вверх

8.3. Извлечение ключа по номеру его индекса

Безусловно то же самое справедливо и для извлечения ключей.

▲ вверх

9. Перебор словаря

9.1. For each по массивам Keys и Items

▲ вверх

9.2. For по массивам Keys и Items

▲ вверх

9.3. Фильтрация элементов

Для фильтрации словаря по ключам или элементам крайне удобно использовать VBA функцию Filter. Вот как это может выглядеть:

▲ вверх

9.4. Выгрузка словаря в диапазон ячеек

Результат:

▲ вверх

9.5. Операции с ключами/элементами при помощи формул рабочего листа

Если ключи/элементы у вас в виде числовых значений, то к ним легко можно применять стандартные функции рабочего листа. Например, ниже я определяю страну с наибольшей территорией и вывожу её название. Числовую территорию в данном случае желательно иметь в виде ключа, так как зная ключ, вывести элемент легко, а вот, зная элемент, найти по нему ключ, гораздо сложнее (потребуется перебор всего словаря).

К вашим услугам и другие функции, такие как: Min(), Large(), Small() и т.д.

▲ вверх

10. Файл примера

Скачать примеры кода VBA

▲ вверх

11. Заключение

Я надеюсь, что данная статья помогла вам хорошенько разобрать с объектом Dictionary. В моих ближайших планах рассказать, как при помощи словаря строить произвольные иерархические структуры. Так же стоит упомянуть, что в VBA есть такой встроенный объект Collection. Однако, по своим функциональным возможностям он достаточно уныл и вчистую проигрывает Dictionary, поэтому я не хочу тратить на него силы и время. Единственное его преимущество это то, что он часть MS Office, а словарь — часть MS Windows, поэтому первый работает в MS Excel for Mac, а второй — нет. Но пока (да и вообще) в нашей стране это обстоятельство можно с лёгкостью игнорировать.

▲ вверх

12. Использованный источник

Массу конкретного материала по объекту Dictionary я подчерпнул из этой замечательной (огромной!) статьи некоего, по всей видимости испанского, автора, имени которого на сайте нет. Очень рекомендую. На сайте также даётся огромное количество примеров работы с объектной моделью Outlook!

What is a Dictionary?

A dictionary is a VBA object that holds al ist of data in pairs of two: A Key and an item.

In simple terms, an item is the value we want to store and a key is the name or reference we want to assign it.

And a VBA dictionary can store multiple such key-item pairs.

This is similar to a real-life dictionary which is basically a list of words as keys and their meanings as items.

How to Use a Dictionary?

We are going to just focus on the parts that we need to get the job done. So, in this section, we will learn how to

create a dictionary,
populate it with data,
retrieve a value
check whether a key exists
write back the contents of a dictionary onto a worksheet.

A dictionary is a VBA object that is available through the Microsoft Scripting Runtime library. We will create the dictionary using late binding, where we create the object instead of referencing the library.

Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")

Next, lets fill our dictionary with some values.

To a add data to a dictionary, we will use the add method.

We need to add the key and the item. Since, we will be looking at a cricket related dataset later on, we will add the Player name as Key and total runs scored as Item.

dic.Add Key:="SR Tendulkar", Item:=15921
dic.Add Key:="RT Ponting", Item:=13378
dic.Add Key:="JH Kallis", Item:=13289

Some points to note here. The Key can be any data type such as number or text. The item can be any data type, an array, a class object or even another dictionary. For this blog though, we will just stick to regular data types.

Next, look at how to retrieve a particular value or item.

Let’s say we want to print out the total runs scored by Ponting. We will call the dictionary object and feed in the key as the parameter.

Debug.Print dic("SR Tendulkar")

Next, let’s look at how to check if a player is within our dictionary or not. If they are not, we will add them to our dictionary.

For this, we will use the Exists method of the dictionary object.

Let’s add in a new player.

If dic.exists("KC Sangakkara") Then
    MsgBox "Player Already Exisits"
    Else
    dic.Add Key:="KC Sangakkara", Item:=12400
End If

One point to note here is that the default .Exists method is case sensitive. We can program it to ignore Case Senstivity by adding the lines dict.CompareMode = vbTextCompare right after we create the dictionary.

And finally, let’s print out the contents of the dictionary onto our worksheet.

For this we need to understand two things.

The index for a dictionary starts from 0. That is, if you want to refer to the first key-item in the dictionary, it will have the position 0.

Debug.Print dic.keys()(0), dic.items()(0)

And for the second point, in order retrieve all the data from a dictionary we need to loop over it. The loop will start from the first index which is 0 to the last index which is the count of all the key-item pairs in the dictionary minus 1.

Dim i As Long
For i = 0 To dic.Count - 1
    Debug.Print dic.keys()(i), dic.items()(i)
Next i

Let’s see the entire sub as covered in the video.

Sub DictionaryBasics()

Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")
'dic.CompareMode = vbTextCompare

dic.Add Key:="SR Tendulkar", Item:=15921
dic.Add Key:="RT Ponting", Item:=13378
dic.Add Key:="JH Kallis", Item:=13289

'Debug.Print dic("SR Tendulkar")

'If dic.exists("SR Tendulkar") Then
'    MsgBox "Player Already Exisits"
'    Else
'    dic.Add Key:="SR Tendulkar", Item:=15921
'End If

If dic.exists("KC Sangakkara") Then
    MsgBox "Player Already Exisits"
    Else
    dic.Add Key:="KC Sangakkara", Item:=12400
End If

'Debug.Print dic("KC Sangakkara")
'Debug.Print dic.keys()(0), dic.items()(0)
Dim i As Long
For i = 0 To dic.Count - 1
    Debug.Print dic.keys()(i), dic.items()(i)
Next i

End Sub

Initial Setup

The main dataset consists of highest scoring cricket players in Test Matches.

Above we have the main dataset which is the sheet: RunsBy. We also, have Output sheet which is blank. And, a Country sheet as well, which has player name in col A and country in col B. It will only be used in the vlookup example.

Example 1: Find Unique Values from a List

In Col L, we can see that the Country Names are repeating in the last column. Let’s grab a unique list of countries within this column.

Create a dictionary.

Dim dicRunsBy As Object
Set dicRunsBy = CreateObject("Scripting.Dictionary")

We will create a For Loop to loop over the dataset.

In the loop, once we read the Country name from the column, feed it into our dictionary.

Here, country is the Key which needs to be unique. So, put in an If statement to only add the country to the dictionary, if it doesn’t exist already. Add the Country which is the Key. We don’t need the Item in this case. So, we will just leave it as 0.

Dim i As Long
For i = 2 To lrowRunsBy
    sCountry = wsRunsBy.Range("l" & i).Value
    If Not dicRunsBy.exists(sCountry) Then
        dicRunsBy.Add Key:=sCountry, Item:=0
    End If
Next i

Now, once the loop is run, the dictionary will get populated with the unique Country names. Paste the results into our output sheet. Create the loop for printing out the dictionary keys. And we just want to paste the Keys in column A in the second row onwards which is i + 2 because i starts from 0.

For i = 0 To dicRunsBy.Count - 1
    wsOutput.Range("a" & i + 2).Value = dicRunsBy.keys()(i)
Next i

That’s it. Running the sub will give the unique Country names in Col A of the Output sheet.

Full sub.

Sub UniqueValues()

Dim wsRunsBy As Worksheet, wsOutput As Worksheet
Set wsRunsBy = ThisWorkbook.Sheets("RunsBy")
Set wsOutput = ThisWorkbook.Sheets("Output")
wsOutput.Range("a2:c" & wsOutput.Rows.Count).Clear

Dim lrowRunsBy As Long
lrowRunsBy = wsRunsBy.Range("a1").CurrentRegion.Rows.Count

Dim sCountry As String

Dim dicRunsBy As Object
Set dicRunsBy = CreateObject("Scripting.Dictionary")

Dim i As Long
For i = 2 To lrowRunsBy
    sCountry = wsRunsBy.Range("l" & i).Value
    If Not dicRunsBy.exists(sCountry) Then
        dicRunsBy.Add Key:=sCountry, Item:=0
    End If
Next i

For i = 0 To dicRunsBy.Count - 1
    wsOutput.Range("a" & i + 2).Value = dicRunsBy.keys()(i)
Next i

wsOutput.Columns("A:c").AutoFit
End Sub

Example 2: Perform Sum & Count on Grouped Values

This example is similar to the previous. We can create another layer on top of that.

Have a look at our data set. Previously, we grabbed the unique values in a column which is the country name. While we are looping through the dataset, we can even count the number of occurrences of these unique values or calculate the sum of another column for each unique value. E.g. Say, we want to find the Total Runs scored per country. We can perform other operations as well such as Average, Max, Min etc. But, for this video, we will stick to Count and Sum.

Use the same sub as previous.

Change the If statement to an If Else. First part will be If the country name Exists and then we will add an Else condition. Let’s address the Else part first. This is where the Country name doesn’t exist. If it doesn’t, we will add the country name to dictionary.

So, in the last example, our Item was 0, which was just an arbitrary value because we weren’t using it. This time, we will use it to count each occurrence of the unique key or country. So, the first time that we encounter a country name, we will assign it a count of one.

This brings us to the upper condition, where the country name already exists in the dictionary.

In this case, we don’t want to add the country to the dictionary. We couldn’t even if we wanted to. So, what we will do here is increase the existing count by one.

Dim i As Long
For i = 2 To lrowRunsBy
    sCountry = wsRunsBy.Range("L" & i).Value
    lRuns = wsRunsBy.Range("F" & i).Value
    If dicRunsBy.exists(sCountry) Then
        dicRunsBy(sCountry) = dicRunsBy(sCountry) + 1

        Else
        dicRunsBy.Add Key:=sCountry, Item:=1

    End If
Next i

Output the values.

Previously, we just pasted out the Keys or the country name. This time, paste the Count which is the Item, in the adjacent cell.

For i = 0 To dicRunsBy.Count - 1
    wsOutput.Range("a" & i + 2).Value = dicRunsBy.keys()(i)
    wsOutput.Range("b" & i + 2).Value = dicRunsBy.items()(i)
Next i

That’s it for Count. This will display Unique Country names in Col A and Count of Country names in Col B. Full sub further below.

Let’s look at how to sum the runs in col F.

In the For Loop, for the Else statement, if the Country doesn’t exist, we will add the country as key and this time, we will add the Runs as Item.

And for the main if condition, if the country already exists, then we will simply add the Runs from the current cell to the previous value of Runs stored for that country.

Dim i As Long
For i = 2 To lrowRunsBy
    sCountry = wsRunsBy.Range("L" & i).Value
    lRuns = wsRunsBy.Range("F" & i).Value
    If dicRunsBy.exists(sCountry) Then
        dicRunsBy(sCountry) = dicRunsBy(sCountry) + lRuns
        Else

        dicRunsBy.Add Key:=sCountry, Item:=lRuns
    End If
Next i

That’s it. rest of the code is same as the Count version.

Full sub for both versions below.

Sub sumCount()

Dim wsRunsBy As Worksheet, wsOutput As Worksheet
Set wsRunsBy = ThisWorkbook.Sheets("RunsBy")
Set wsOutput = ThisWorkbook.Sheets("Output")
wsOutput.Range("a2:c" & wsOutput.Rows.Count).Clear

Dim lrowRunsBy As Long
lrowRunsBy = wsRunsBy.Range("a1").CurrentRegion.Rows.Count

Dim sCountry As String, lRuns As Long

Dim dicRunsBy As Object
Set dicRunsBy = CreateObject("Scripting.Dictionary")

Dim i As Long
For i = 2 To lrowRunsBy
    sCountry = wsRunsBy.Range("L" & i).Value
    lRuns = wsRunsBy.Range("F" & i).Value
    If dicRunsBy.exists(sCountry) Then
        'dicRunsBy(sCountry) = dicRunsBy(sCountry) + 1
        dicRunsBy(sCountry) = dicRunsBy(sCountry) + lRuns
        Else
        'dicRunsBy.Add Key:=sCountry, Item:=1
        dicRunsBy.Add Key:=sCountry, Item:=lRuns
    End If
Next i

For i = 0 To dicRunsBy.Count - 1
    wsOutput.Range("a" & i + 2).Value = dicRunsBy.keys()(i)
    wsOutput.Range("b" & i + 2).Value = dicRunsBy.items()(i)
Next i

wsOutput.Columns("A:c").AutoFit
End Sub

Example 3: Copy & Paste Data Dynamically

So, far we have been using the Exists method as footnote. In this example, it will be the main feature.

Here, we will look at how to dynamically copy data from one worksheet to another.

Lets look at our dataset. We just want to copy the columns Country, Player and Total Runs into the Output sheet.

You will notice that the column are not in sequence. And, there are columns in the Output sheet that are not in the Data sheet. So, we don’t want to copy anything into this column.

Copying this way using the traditional method of defining the ranges using current region is almost impossible. Here’s where dictionary shines and is must know technique.

Create a dictionary.

Dim dicHeader As Object
Set dicHeader = CreateObject("Scripting.Dictionary")

Loop across the column headers from left to right in the RunsBy dataset. Grab the column header. and feed it into our dictionary. For the item, we will feed in the current column position, which we will be needing later on for copying and pasting.

Dim i As Long
For i = 1 To lcolRunsBy
    sHeader = wsRunsBy.Cells(1, i).Value
    dicHeader.Add Key:=sHeader, Item:=i
Next i

Next, grab the last column of the output sheet. Now, this time, we will loop from left to right, across the column headers of the output sheet and first, check whether each column header exists in the dictionary consisting of column headers from the data sheet.

And if the column header or key exists, we will copy the data from that column using the column position which is stored as the Item or Value of that key in the dictionary.

For the copy method, we will define the range using cells. So, we need to state the first cell which starts in the 2^nd row and column number form the item. And the final cell, which is in the last row and column number from the item.

For i = 1 To lcolOutput
    sHeader = wsOutput.Cells(1, i).Value
    If dicHeader.exists(sHeader) Then
        wsRunsBy.Range(wsRunsBy.Cells(2, dicHeader(sHeader)), wsRunsBy.Cells(lrowRunsBy, dicHeader(sHeader))).Copy _
            wsOutput.Cells(2, i)
    End If
Next i

And that’s it. The right data will get pasted into the right columns.

Full sub here.

Sub CheckIfExists()

Dim wsRunsBy As Worksheet, wsOutput As Worksheet
Set wsRunsBy = ThisWorkbook.Sheets("RunsBy")
Set wsOutput = ThisWorkbook.Sheets("Output")
wsOutput.Range("a2:d" & wsOutput.Rows.Count).Clear

Dim lrowRunsBy As Long
lrowRunsBy = wsRunsBy.Range("a1").CurrentRegion.Rows.Count
Dim lcolRunsBy As Long
lcolRunsBy = wsRunsBy.Range("a1").CurrentRegion.Columns.Count

Dim sHeader As String

Dim dicHeader As Object
Set dicHeader = CreateObject("Scripting.Dictionary")

Dim i As Long
For i = 1 To lcolRunsBy
    sHeader = wsRunsBy.Cells(1, i).Value
    dicHeader.Add Key:=sHeader, Item:=i
Next i

Dim lcolOutput As Long
lcolOutput = wsOutput.Range("a1").CurrentRegion.Columns.Count

For i = 1 To lcolOutput
    sHeader = wsOutput.Cells(1, i).Value
    If dicHeader.exists(sHeader) Then
        wsRunsBy.Range(wsRunsBy.Cells(2, dicHeader(sHeader)), wsRunsBy.Cells(lrowRunsBy, dicHeader(sHeader))).Copy _
            wsOutput.Cells(2, i)
    End If
Next i

wsOutput.Columns("A:D").AutoFit
End Sub

Example 4: Perform VlookUps

Let’s move on to the last use case, which is also my favorite use for a dictionary i.e. looking up values.

So, this time, we are going to tweak the dataset a bit. Instead of having the Country column within the main dataset, we will delete this column off. And then, come on over to the sheet Country. Here, we have a map of each player and the respective country they belong to. If we had this scenario in our corporate reports, we would just vlookup the value of the player from the main dataset against this table and grab the country.

We can do this through dictionaries too.

Lets create our dictionary. This time around, we are going to loop over the Country sheet and feed in the values into the dictionary: with player as key and country as item.

So, create the dictionary.

Dim dicCountryMap As Object
Set dicCountryMap = CreateObject("Scripting.Dictionary")

Create the loop. Grab the player name from col A and country from col B.

We are doing this vlookup style, where the column with the matching value is the first column and corresponding value is in a column on the right. But, in reality, the corresponding value could be on the left or right, doesn’t matter. Dictionary is very flexible.

Back to the loop. If the player doesn’t exist in the dictionary, feed in the player as key and country as item.

Dim i As Long
For i = 2 To lrowCountry
    sPlayer = wsCountry.Range("A" & i).Value
    sCountry = wsCountry.Range("B" & i).Value
    If Not dicCountryMap.exists(sPlayer) Then
        dicCountryMap.Add Key:=sPlayer, Item:=sCountry
    End If
Next i

Now, reference the main dataset. We are going to loop over it, and for each player name in col A, we will check whether a key exists in the dictionary with the same player name. If it does, we will grab the item or country name and place it in Col L. If it doesn’t we will fill the text Unknown in col L.

For i = 2 To lrowRunsBy
    sPlayer = wsRunsBy.Range("A" & i).Value
    If dicCountryMap.exists(sPlayer) Then
        wsRunsBy.Range("L" & i).Value = dicCountryMap(sPlayer)
        Else
        wsRunsBy.Range("L" & i).Value = "Unknown"
    End If
Next i

Full sub here.

Sub DoLookUps()

Dim wsRunsBy As Worksheet, wsOutput As Worksheet
Set wsRunsBy = ThisWorkbook.Sheets("RunsBy")
Set wsOutput = ThisWorkbook.Sheets("Output")
wsOutput.Range("a2:c" & wsOutput.Rows.Count).Clear

Dim wsCountry As Worksheet
Set wsCountry = ThisWorkbook.Sheets("Country")

Dim lrowCountry As Long
lrowCountry = wsCountry.Range("a1").CurrentRegion.Rows.Count

Dim lrowRunsBy As Long
lrowRunsBy = wsRunsBy.Range("a1").CurrentRegion.Rows.Count

Dim sCountry As String, sPlayer As String

Dim dicCountryMap As Object
Set dicCountryMap = CreateObject("Scripting.Dictionary")

Dim i As Long
For i = 2 To lrowCountry
    sPlayer = wsCountry.Range("A" & i).Value
    sCountry = wsCountry.Range("B" & i).Value
    If Not dicCountryMap.exists(sPlayer) Then
        dicCountryMap.Add Key:=sPlayer, Item:=sCountry
    End If
Next i

For i = 2 To lrowRunsBy
    sPlayer = wsRunsBy.Range("A" & i).Value
    If dicCountryMap.exists(sPlayer) Then
        wsRunsBy.Range("L" & i).Value = dicCountryMap(sPlayer)
        Else
        wsRunsBy.Range("L" & i).Value = "Unknown"
    End If
Next i

End Sub

Источник