Option Explicit

 

 

Sub Creation()

 

  ' ВАРИАНТ 1 - раннее связывание

  ' ------------------------------------------------------

  ' декларируем объектную переменную

  Dim dicTemp1 As Dictionary ' нужно, если есть опция Option Explicit

  ' либо можно так: Dim dicTemp1

  ' либо так:       Dim dicTemp1 as Object

 

  ' создаём объект и присваиваем ссылку на него переменной

  Set dicTemp1 = New Dictionary

 

  ' проверяем что объект работает, выводя количество элементов

  ' сейчас их там, конечно же, нет ни одного

  MsgBox dicTemp1.Count

 

 

  ' ВАРИАНТ 2 - раннее связывание

  ' ------------------------------------------------------

  ' декларируем и сразу создаём объект

  Dim dicTemp2 As New Dictionary

 

  ' проверяем что объект работает

  MsgBox dicTemp2.Count

 

 

  ' ВАРИАНТ 3 - раннее связывание (без переменной)

  ' ------------------------------------------------------

  With New Dictionary

    MsgBox .Count

  End With

 

 

  ' ВАРИАНТ 4 - позднее связывание

  ' ------------------------------------------------------

  Dim dicTemp4 ' нужно, если есть опция Option Explicit

 

  Set dicTemp4 = CreateObject("Scripting.Dictionary")

   

   

  ' ВАРИАНТ 5 - позднее связывание (без переменной)

  ' ------------------------------------------------------

  With CreateObject("Scripting.Dictionary")

    MsgBox .Count

  End With

   

   

End Sub

 

 

Sub HowToAddElement()

 

  Dim dicCountry, row As Integer

  Dim key As String, Item As Double

  Set dicCountry = CreateObject("Scripting.Dictionary")

 

  With Sheets("Example").Range("SquareByCountry")

    For row = 1 To .Rows.Count

      key = CStr(.Cells(row, 1).Value)

      Item = CDbl(.Cells(row, 2).Value)

      dicCountry.Add key, Item

    Next

  End With

 

End Sub

 

 

Sub HowToAddElement2()

 

  Dim dicCountry, row As Integer

  Dim key As String, Item As Double

  Set dicCountry = CreateObject("Scripting.Dictionary")

 

  With Sheets("Example").Range("SquareByCountry")

    For row = 1 To .Rows.Count

      key = CStr(.Cells(row, 1).Value)

      Item = CDbl(.Cells(row, 2).Value)

      dicCountry.Item(key) = Item

    Next

  End With

 

End Sub

 

 

Sub ImplicitKeyAddition()

 

  Dim dicCountry, row As Integer

  Dim key As String

  Dim varTemp

  Set dicCountry = CreateObject("Scripting.Dictionary")

 

  With Sheets("Example").Range("SquareByCountry")

    For row = 1 To .Rows.Count

      key = CStr(.Cells(row, 1).Value)

      varTemp = dicCountry.Item(key)

    Next

  End With

 

End Sub

 

Sub ShowDifferentKeys()

 

  On Error Resume Next

 

  Dim dicTemp As New Dictionary

  Dim strShow As String, key As Variant

 

  dicTemp.Add Date, "Date type" ' добавляем ключ с типом дата

 

  dicTemp.Add True, "Boolean type" ' добавляем ключ с логическим типом

 

  dicTemp.Add CDbl(12.4567), "Double type" ' добавляем ключ с типом Double

 

  dicTemp.Add CInt(12999), "Integer type" ' добавляем ключ с типом Integer

 

  dicTemp.Add "Red", "String type" ' добавляем строковый ключ

 

  dicTemp.Add ActiveSheet, "Worksheet object" ' добавляем ключ в виже Worksheet объекта

 

  For Each key In dicTemp.Keys ' перебираем ключи словаря (тут немного забегаю вперёд)

    Err.Clear ' очищаю ошибку

    ' Для каждого элемента словаря формирую строку ключ - тип ключа

    ' Тип ключа выясняем при помощи функции TypeName

    strShow = strShow & CStr(key) & vbTab & vbTab & TypeName(key) & vbCr

    ' Поскольку у нас один из ключей имеет объектный тип, то CStr(key) выдаст ошибку

    ' которую мы перехватим и CStr(key) заменим на key.Name

    If Err Then strShow = strShow & key.Name & vbTab & vbTab & TypeName(key) & vbCr

  Next

 

  ' Выведем на экран результат

  MsgBox strShow, vbInformation, "Он реально хранит типы ключей!"

 

End Sub

 

 

Sub ShowCompareMode()

  On Error Resume Next

 

  With New Dictionary

    .CompareMode = TextCompare ' текстовый режим - игнорирует регистр

   

    .Add "Россия", 17098

    .Add "РоссиЯ", 17098 ' тут будет сгенерировано исключение

   

    MsgBox Join(.Keys, vbLf), , "Россия и РоссиЯ"

    .RemoveAll 'очищаем словарь, иначе изменение CompareMode вызовет ошибку

   

   

    .CompareMode = BinaryCompare ' двоичный режим - различает регистр

   

    .Add "США", 9519

    .Add "Сша", 9519 ' будут добавлены оба элемента

   

    MsgBox Join(.Keys, vbLf), , "США и Сша"

   

  End With

End Sub

 

Sub ShowUniqKeys()

  Dim Element

  With CreateObject("Scripting.Dictionary")

    For Each Element In Array("Один", "Два", "Три", "Четыре", "Пять")

      ' Используем Count в качестве значения ключа

      ' таким образом ключи будут 0,1,2,3,4

      .Item(.Count) = Element

    Next

    MsgBox Join(.Keys, vbLf)

  End With

End Sub

 

Sub ShowDifferentItems()

 

  Dim dicTemp As New Dictionary

  Dim strShow As String, Item As Variant

 

  With dicTemp

    .Add .Count, Date ' добавляем элемент с типом дата

   

    .Add .Count, True ' добавляем элемент с логическим типом

   

    .Add .Count, CDbl(12.4567) ' добавляем элемент с типом Double

   

    .Add .Count, CInt(12999) ' добавляем элемент с типом Integer

   

    .Add .Count, "Red" ' добавляем строковый элемент

   

    .Add .Count, ActiveSheet ' добавляем элемент в виде Worksheet объекта

   

    .Add .Count, Array(11, 22, 33) ' добавляем элемент типа массив

 

    For Each Item In .Items ' перебираем элементы словаря (тут немного забегаю вперёд)

      Err.Clear ' очищаю ошибку

      ' Для каждого элемента словаря формирую строку c типом элемента

      ' Тип элемента выясняем при помощи функции TypeName

      strShow = strShow & TypeName(Item) & vbCr

    Next

  End With

   

  ' Выведем на экран результат

  MsgBox strShow, vbInformation, "Он реально хранит типы элементов!"

 

End Sub

 

 

Sub UDT_through_Class()

 

  Dim objRGB As MyRGB ' объявляем переменную с типом нашего класса

 

  Set objRGB = New MyRGB ' создаём наш объект

 

  ' Присваиваем какие-то значения

  objRGB.Red = 100

  objRGB.Green = 150

  objRGB.Blue = 200

 

  With New Dictionary ' создаём словарь

    .Add "test", objRGB ' добавляем в качестве элемента наш объект

    ' Теперь мы можем обращаться к отдельным свойствам данного элемента словаря

    ' в частности, мы тут прочли красную ("Red") компоненту структуры

    MsgBox "К примеру, красная компонента равна " & .Item("test").Red

  End With

 

End Sub

 

Sub Get_Item_By_Key()

  With New Dictionary

   

    .Add "Россия", 17098 ' добавляем элемент

   

    MsgBox .Item("Россия") ' и извлекаем элемент

   

  End With

End Sub

 

Sub Get_Item_By_Index()

 

  Dim dicTemp As New Dictionary ' объявляем и сразу создаём словарь

  Dim varCountry As Variant ' вспомогательная переменная

 

  With dicTemp ' работаем со словарём

 

    ' Организуем цикл по массиву из 5 элементов

    For Each varCountry In Array("Russia", "Canada", "China", "USA", "Brazil")

      ' наполняем словарь парами вида "Key 1" - "Russia", "Key 2" - "Canada"

      .Item("Key " & CStr(.Count + 1)) = varCountry ' используем способ из 4.3.

    Next

   

    ' Извлекаем элементы по их индексу! Обратите внимание на синтаксис!

    ' наиболее неожиданно тут то, что после Items надо использовать пустые скобки

    MsgBox .Items()(0) ' вернёт Russia, так как нумерация начинается с нуля

    MsgBox .Items()(3) ' вернёт USA

   

    MsgBox .Items()(.Count - 1) ' классика - последний элемент!

    MsgBox .Items()(UBound(.Keys)) ' немного экзотики - тоже последний элемент :)

   

  End With

End Sub

 

Sub Loop_1()

 

  Dim dicTemp As New Dictionary

  Dim varCountry As Variant

  Dim varKey As Variant, varItem As Variant

  Dim strShow As String

 

  With dicTemp

   

    For Each varCountry In Array("Russia", "Canada", "China", "USA", "Brazil")

      .Item("Key " & CStr(.Count + 1)) = varCountry

    Next

   

    For Each varKey In .Keys ' организуем цикл по элементам  масива Keys

      strShow = strShow & .Item(varKey) & vbLf

    Next

   

    MsgBox strShow, vbInformation, "Цикл по Keys"

   

    strShow = vbNullString

   

    For Each varItem In .Items ' организуем цикл по элементам  масива Items

      strShow = strShow & varItem & vbLf

    Next

   

    MsgBox strShow, vbInformation, "Цикл по Items"

   

  End With

End Sub

 

 

Sub Loop_2()

 

  Dim dicTemp As New Dictionary

  Dim varCountry As Variant

  Dim strShow As String, i As Integer

 

  With dicTemp

   

    For Each varCountry In Array("Russia", "Canada", "China", "USA", "Brazil")

      .Item("Key " & CStr(.Count + 1)) = varCountry

    Next

   

    For i = 0 To .Count - 1

      strShow = strShow & .Items()(i) & vbLf

    Next

   

    MsgBox strShow, vbInformation, "Цикл по Items"

   

    strShow = vbNullString

   

    For i = 0 To .Count - 1

      strShow = strShow & .Keys()(i) & vbLf

    Next

   

    MsgBox strShow, vbInformation, "Цикл по Keys"

   

  End With

End Sub

 

 

Sub Filter_1()

 

  Dim dicTemp As New Dictionary

  Dim varCountry As Variant

  Dim varItem As Variant

 

  With dicTemp

   

    For Each varCountry In Array("Russia", "Canada", "China", "USA", "Brazil")

      .Item("Key " & CStr(.Count + 1)) = varCountry

    Next

   

    ' Используем метод Filter объекта Application!

    For Each varItem In Filter(.Items, "r", , vbTextCompare)

      MsgBox varItem ' будет отфильтрованы Russia и Brazil

    Next

   

  End With

End Sub

 

 

Sub Fill_Range()

 

  Dim dicTemp As New Dictionary

  Dim varCountry As Variant

  Dim varItem As Variant

 

  With dicTemp

   

    For Each varCountry In Array("Russia", "Canada", "China", "USA", "Brazil")

      .Item("Key " & CStr(.Count + 1)) = varCountry

    Next

   

    ' вытягиваем элементы по строке

    Cells(1, 1).Resize(, .Count) = .Keys

    Cells(2, 1).Resize(, .Count) = .Items

 

    ' вытягиваем элементы по столбцу

    Cells(4, 1).Resize(.Count) = Application.Transpose(.Keys)

    Cells(4, 2).Resize(.Count) = Application.Transpose(.Items)

 

  End With

End Sub

 

 

Sub Operations_with_Keys()

 

  Dim dicTemp As New Dictionary

  Dim arrItems, arrKeys

  Dim i As Integer

 

  With dicTemp

   

    ' определяем массивы для ключей и элементов

    arrKeys = Array(17098, 9976, 9598, 9519, 8511)

    arrItems = Array("Russia", "Canada", "China", "USA", "Brazil")

       

    ' добавляем массивы в словарь

    For i = 0 To UBound(arrKeys)

      .Add arrKeys(i), arrItems(i)

    Next

           

    ' находим максимальное значение ключа, а по ключу извлекаем элемент (название страны)

    MsgBox .Item(Application.WorksheetFunction.Max(.Keys)) & " has the largest territory."

 

  End With

End Sub