Перейти к содержимому

VBA Excel. Отбор уникальных значений с помощью Dictionary

Отбор уникальных значений из списка в VBA Excel с помощью объекта Dictionary. Выгрузка уникальных элементов в ячейки рабочего листа. Два способа отбора.

  1. Традиционный способ отбора
  2. Нетрадиционный способ отбора
  3. Выгрузка уникальных значений

Также как и объект Collection, объект Dictionary не допускает добавления двух одинаковых ключей. Эту особенность словаря будем использовать для отбора уникальных значений из списка. Преимущество словаря перед коллекцией заключается в возможности извлечь из него и ключи, и элементы одним массивом.

Традиционный способ отбора

Sub Primer1()
Dim myDictionary As Object, myCell As Range, _
myElement As Variant, n As Long
Set myDictionary = CreateObject("Scripting.Dictionary")
'Отбор уникальных значений из диапазона
  On Error Resume Next
    For Each myCell In Range("A1:A10")
      myDictionary.Add CStr(myCell), CStr(myCell)
    Next
  On Error GoTo 0
'Выгрузка уникальных значений на рабочий лист
  For Each myElement In myDictionary.Items
    n = n + 1
    Cells(n, 2) = myElement
  Next
End Sub

Переменные:

  • myDictionary – словарь (объект Dictionary);
  • myCell – ячейка диапазона, к которой обращается цикл For Each... Next при очередной итерации;
  • myElement – элемент словаря, к которому обращается цикл For Each... Next при выгрузке уникальных значений;
  • n – номер очередной строки при выгрузке уникальных значений на рабочий лист.

Нетрадиционный способ отбора

Sub Primer2()
Dim myDictionary As Object, myCell As Range, myElement As Variant
Set myDictionary = CreateObject("Scripting.Dictionary")
'Отбор уникальных значений из диапазона
  For Each myCell In Range("A1:A10")
    myElement = myDictionary.Item(CStr(myCell))
  Next
'Выгрузка уникальных значений на рабочий лист
Range("B1").Resize(myDictionary.Count) = Application.Transpose(myDictionary.Keys)
End Sub

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

Самое интересное заключается в том, что при попытке добавить неуникальный ключ, он просто не добавится, а ошибка сгенерирована не будет. Поэтому блоки операторов On Error Resume Next и On Error GoTo 0 не нужны.

Выгрузка уникальных значений

Способы выгрузки уникальных элементов из объекта Dictionary на рабочий лист Excel уже представлены в примерах традиционного и нетрадиционного отборов. В первом случае используется цикл VBA, во втором – присвоение массива ключей словаря диапазону.

В коде первого примера уникальные значения записываются и как элементы и как ключи, поэтому строку
For Each myElement In myDictionary.Items
можно заменить на
For Each myElement In myDictionary.Keys.

Если в коде второго примера необходимо уникальные значения записать не в столбец, а в строку, следует
Range("B1").Resize(myDictionary.Count) = Application.Transpose(myDictionary.Keys)
заменить на
Range("B1").Resize(, myDictionary.Count) = myDictionary.Keys.

Уникальные элементы из словаря можно выгрузить не только на рабочий лист, но и в динамический массив:

'Назначаем размерность массива
ReDim myMassiv(myDictionary.Count - 1)
'Выгружаем ключи словаря в динамический массив
myMassiv = myDictionary.Keys
'или выгружаем массив элементов словаря
myMassiv = myDictionary.Items
'Проверяем элементы заполненного массива
For i = 0 To myDictionary.Count - 1
  MsgBox myMassiv(i)
Next

Используя массив ключей или элементов словаря, очень просто заполнить уникальными элементами ComboBox:

With UserForm1
  .ComboBox1.List = myDictionary.Keys
  .Show
End With

Смотрите, как удалить повторяющиеся значения из диапазона ячеек в VBA Excel с помощью метода Range.RemoveDuplicates и отобрать уникальные значения из списка с помощью объекта Collection.

Добавить комментарий

Ваши комментарии, отправленные после 19 мая, будут опубликованы в конце мая после выхода на работу модератора. Ваш комментарий будет опубликован после прохождения обязательной модерации. Исходящие ссылки не допускаются. Время модерации составит от нескольких минут до нескольких часов в зависимости от времени суток и занятости модератора.