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

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.

Содержание рубрики VBA Excel по тематическим разделам со ссылками на все статьи.

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

Ваш комментарий будет опубликован после прохождения обязательной модерации. Исходящие ссылки не допускаются. Время модерации составит от нескольких минут до нескольких часов в зависимости от времени суток и занятости модератора. При добавлении в комментарий кода VBA Excel, вставьте перед его началом тег [vb] и по окончании кода - [/vb].