Найти в Дзене
Макрос решает

Соберите уникальные значения в Excel одной кнопкой: мощный VBA-макрос без дублей

Соберите список без дублей одной кнопкой: как VBA находит уникальные значения в Excel и чистит хаос в таблице. Подробно разбираем, как автоматически формировать список уникальных значений в Excel с помощью VBA. Один макрос собирает клиентов, сотрудников, статусы, проекты или товары без повторов. Готовый код, разбор строк, реальные сценарии и адаптация под свою таблицу. Есть одна очень тихая, но очень надоедливая проблема, которую многие почему-то считают мелочью. Пока она не начинает красть время каждый день. У вас есть большая рабочая таблица. В ней клиенты, сотрудники, статусы, товары, проекты, города, категории, объекты, номера договоров — что угодно. Всё живёт в одном списке, строки копятся, данные растут. И в какой-то момент нужно получить простой ответ на простой вопрос. Какие у нас вообще клиенты?
Какие сотрудники есть в этой выборке?
Какие статусы сейчас встречаются в таблице?
Какие проекты фигурируют в этом месяце?
Какие товары реально продавались, а не просто мелькали по стр
Оглавление

Соберите список без дублей одной кнопкой: как VBA находит уникальные значения в Excel и чистит хаос в таблице. Подробно разбираем, как автоматически формировать список уникальных значений в Excel с помощью VBA. Один макрос собирает клиентов, сотрудников, статусы, проекты или товары без повторов. Готовый код, разбор строк, реальные сценарии и адаптация под свою таблицу.

Когда в таблице одно и то же повторяется десять раз, Excel начинает просить порядок

Есть одна очень тихая, но очень надоедливая проблема, которую многие почему-то считают мелочью. Пока она не начинает красть время каждый день.

У вас есть большая рабочая таблица. В ней клиенты, сотрудники, статусы, товары, проекты, города, категории, объекты, номера договоров — что угодно. Всё живёт в одном списке, строки копятся, данные растут. И в какой-то момент нужно получить простой ответ на простой вопрос.

Какие у нас вообще клиенты?
Какие сотрудники есть в этой выборке?
Какие статусы сейчас встречаются в таблице?
Какие проекты фигурируют в этом месяце?
Какие товары реально продавались, а не просто мелькали по строкам?

И вот тут начинается старая офисная гимнастика.

Кто-то копирует целый столбец в сторону.
Потом удаляет дубли вручную.
Потом замечает пустые ячейки.
Потом понимает, что вместе с «ООО Альфа» попало «ООО Альфа » с пробелом на конце.
Потом оказывается, что «иванов» и «Иванов» Excel считает разными значениями.
Потом кто-то говорит: «Да я быстро через фильтр сделаю».
А через пятнадцать минут все уже понимают, что «быстро» было слишком смелым словом.

Именно в таких местах VBA начинает показывать свою настоящую цену. Не в показных фокусах, а в маленьких рабочих действиях, которые повторяются изо дня в день. Список уникальных значений — как раз такой сценарий. Неброский. Зато очень рабочий.

Реальная рабочая ситуация, где дубли мешают сильнее, чем кажется

Представим обычную таблицу продаж. В ней 800 строк. Один и тот же клиент встречается десять раз, потому что были разные заказы. Один и тот же менеджер — сорок раз, потому что он вёл много сделок. Статусы повторяются бесконечно. Названия проектов иногда написаны одинаково, иногда с пробелом в конце, иногда в другом регистре.

Теперь задача: нужно быстро собрать отдельный список клиентов для отчёта. Или перечень сотрудников для выпадающего списка. Или набор статусов для контроля. Или список товаров, которые реально фигурируют в таблице.

Руками это делать скучно. Формулами — можно, но не всегда удобно. Стандартная команда «Удалить дубликаты» помогает, но тоже не всегда идеальна. Потому что человеку нужно не испортить исходную таблицу, не забыть про пустые значения, не потерять пробелы, не устроить себе лишний служебный столбец и желательно вообще не тратить на это полдня.

А если таких таблиц несколько? А если список нужно обновлять регулярно? А если его потом использовать в другом макросе? Тогда уже хочется не «ещё один способ», а нормальный рабочий инструмент.

Где такой сценарий особенно полезен

Сценарий 1. Продажи, клиенты, сотрудники, статусы

Есть большая таблица заявок или сделок. Нужно получить:

  • список уникальных клиентов;
  • список менеджеров;
  • список статусов;
  • список каналов продаж.

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

Сценарий 2. Склад, логистика, закупки, производство

Есть журнал заказов или отгрузок. Нужно быстро собрать:

  • уникальные товары;
  • уникальные поставщики;
  • уникальные города;
  • уникальные объекты;
  • уникальные исполнители.

Это полезно для сводок, отбора, построения дополнительных отчётов и просто для понимания, что вообще происходит в массиве данных.

Сценарий 3. Административные таблицы, HR, документооборот

Кандидаты, вакансии, этапы, подразделения, статусы документов, филиалы, кураторы, типы задач. Везде, где есть повторяющийся столбец и где нужен «чистый список без дублей», этот сценарий работает очень хорошо.

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

Почему ручные способы раздражают

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

Первая беда — повторы.
Вторая — пустые ячейки.
Третья — лишние пробелы.
Четвёртая — разный регистр.
Пятая — риск тронуть исходную таблицу, когда трогать её вообще не хотелось.

Многие делают так: копируют столбец, вставляют на новый лист, нажимают «Удалить дубликаты». Способ рабочий. Но он всё равно требует ручного ритуала. А любой ритуал, который нужно повторять постоянно, со временем начинает раздражать, а потом выполняется наспех. А работа наспех — это вечный поставщик мелких ошибок.

Вот почему кнопка «собрать уникальные значения» ощущается гораздо приятнее, чем кажется на бумаге. Она убирает не только действия, но и лишнее трение в процессе.

Формулы могут помочь, но не всегда это лучший путь

Да, в новых версиях Excel можно использовать формулу:

=УНИК(A2:A500)

Это хороший инструмент. Он действительно работает. Но есть несколько «но».

Во-первых, функция есть не во всех версиях Excel.
Во-вторых, иногда нужен не просто результат на листе, а управляемый сценарий внутри VBA.
В-третьих, часто хочется сразу убрать пустые значения, пробелы и лишний мусор.
В-четвёртых, один и тот же макрос потом можно встроить в более сложную автоматизацию: сформировать список, передать его в другой лист, использовать для проверки, построить на его основе выпадающий список или отдельный отчёт.

То есть формула — хороший инструмент. Но VBA в этом месте даёт больше управляемости. Особенно если ты строишь не разовый трюк, а рабочую систему.

Что мы хотим получить в итоге

Предположим, у нас есть лист Данные. На нём таблица:

A — Дата
B — Клиент
C — Задача
D — Ответственный
E — Срок
F — Статус
G — Комментарий

Допустим, нам нужно собрать уникальный список клиентов из столбца B и вывести его на отдельный лист Уникальные значения.

Макрос должен сделать следующее:

  • найти последнюю строку;
  • прочитать все значения в нужном столбце;
  • убрать пустые ячейки;
  • убрать лишние пробелы;
  • не добавлять дубликаты;
  • создать новый лист или очистить старый;
  • вывести аккуратный список.

И всё это — одной кнопкой.

Первый рабочий вариант: список уникальных значений через Collection

Начнём с самого понятного варианта. Он хорошо подходит для тех, кто только начинает разбираться в VBA.

Макрос решает

Ниже — макрос, который собирает уникальные значения из столбца B на листе Данные и выводит их на лист Уникальные значения.

Sub СобратьУникальныеЗначения_Collection()
Dim wsSource As Worksheet*
Dim wsResult As Worksheet*
Dim lastRow As Long*
Dim i As Long*
Dim currentValue As String*
Dim uniqueList As Collection*
Dim item As Variant*
On Error Resume Next*
Set wsSource = ThisWorkbook.Worksheets("Данные")*
Set wsResult = ThisWorkbook.Worksheets("Уникальные значения")*
If wsResult Is Nothing Then*
Set wsResult = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))*

wsResult.Name = "Уникальные значения"*

Else*
wsResult.Cells.Clear*

End If*
Set uniqueList = New Collection*
lastRow = wsSource.Cells(wsSource.Rows.Count, 2).End(xlUp).Row*
For i = 2 To lastRow*
currentValue = Trim(wsSource.Cells(i, 2).Value)*

If currentValue <> "" Then*

uniqueList.Add currentValue, LCase(currentValue)*

End If*

Next i*
On Error GoTo 0*
wsResult.Range("A1").Value = "Уникальные клиенты"*
i = 2*
For Each item In uniqueList*
wsResult.Cells(i, 1).Value = item*

i = i + 1*

Next item*
wsResult.Columns("A:A").AutoFit*
MsgBox "Список уникальных значений сформирован.", vbInformation*
End Sub

Как работает Collection и почему здесь используется On Error Resume Next

Разберём всё спокойно. Без тумана и без позы «это очевидно».

1. Указываем исходный и итоговый лист

Set wsSource = ThisWorkbook.Worksheets("Данные")Set wsResult = ThisWorkbook.Worksheets("Уникальные значения")

Первый лист — откуда читаем данные.
Второй — куда выводим результат.

Если листа результата нет, макрос создаёт его. Если есть — очищает. Это хороший рабочий подход: каждый запуск даёт свежий список, а не кашу из старых и новых значений.

2. Создаём коллекцию

Set uniqueList = New Collection

Collection — это объект, который может хранить набор элементов. Важный момент в том, что в неё можно добавлять элементы с ключом. И если попробовать добавить второй элемент с тем же ключом, VBA выдаст ошибку. Именно этим мы и пользуемся.

3. Находим последнюю строку нужного столбца

lastRow = wsSource.Cells(wsSource.Rows.Count, 2).End(xlUp).Row

Здесь макрос ищет последнюю заполненную строку в столбце B, потому что именно оттуда мы собираем клиентов.

4. Читаем значения по строкам

For i = 2 To lastRow
currentValue = Trim(wsSource.Cells(i, 2).Value)*

Начинаем со второй строки, если первая — заголовок.
Trim убирает лишние пробелы по краям. Это очень полезно. Потому что «ООО Альфа» и «ООО Альфа » визуально одинаковы, а логически нет.

5. Игнорируем пустые строки

If currentValue <> "" Then

Если после очистки от пробелов строка всё ещё не пустая, можно работать дальше.

6. Добавляем значение в коллекцию с ключом

uniqueList.Add currentValue, LCase(currentValue)

Вот здесь самое интересное.

Мы добавляем в коллекцию значение currentValue, а в качестве ключа используем его же, но в нижнем регистре. Это позволяет не различать «Иванов» и «иванов».

Если такой ключ уже существует, VBA выдаст ошибку. А у нас выше стоит:

On Error Resume Next

Это значит: если при добавлении возникает ошибка из-за дубля, просто пропусти её и иди дальше.

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

7. Возвращаем обычный режим ошибок

On Error GoTo 0

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

8. Выводим результат

For Each item In uniqueList
wsResult.Cells(i, 1).Value = item*
i = i + 1*
Next item

Дальше всё просто: проходим по коллекции и выводим элементы на лист.

Недостаток Collection и почему многие переходят на Dictionary

Collection хороша своей простотой. Но у неё есть одно неудобство: работа с дублями через On Error Resume Next не всегда выглядит красиво и прозрачно.

Макрос решает

Поэтому для более серьёзных рабочих сценариев многие используют Dictionary. Он даёт более явный контроль: можно напрямую проверить, есть ключ или нет, а не ждать ошибки как сигнала.

И вот это уже тот вариант, который особенно хорош для серии 7. Потому что он не только работает, но и даёт читателю чувство следующей ступени мастерства.

Второй рабочий вариант: уникальные значения через Dictionary

Ниже — более сильный и более гибкий макрос. Он собирает уникальные значения через Dictionary.

Sub СобратьУникальныеЗначения_Dictionary()
Dim wsSource As Worksheet*
Dim wsResult As Worksheet*
Dim lastRow As Long*
Dim i As Long*
Dim currentValue As String*
Dim dict As Object*
Dim key As Variant*
Set wsSource = ThisWorkbook.Worksheets("Данные")*
On Error Resume Next*
Set wsResult = ThisWorkbook.Worksheets("Уникальные значения")*
On Error GoTo 0*
If wsResult Is Nothing Then*
Set wsResult = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))*

wsResult.Name = "Уникальные значения"*

Else*
wsResult.Cells.Clear*

End If*
Set dict = CreateObject("Scripting.Dictionary")*
lastRow = wsSource.Cells(wsSource.Rows.Count, 2).End(xlUp).Row*
For i = 2 To lastRow*
currentValue = Trim(wsSource.Cells(i, 2).Value)*

If currentValue <> "" Then*

If Not dict.Exists(LCase(currentValue)) Then*

dict.Add LCase(currentValue), currentValue*

End If*

End If*

Next i*
wsResult.Range("A1").Value = "Уникальные клиенты"*
i = 2*
For Each key In dict.Keys*
wsResult.Cells(i, 1).Value = dict(key)*

i = i + 1*

Next key*
wsResult.Columns("A:A").AutoFit*
MsgBox "Список уникальных значений сформирован.", vbInformation*
End Sub

Почему Dictionary в реальной работе часто удобнее

Теперь разберёмся, за что его любят.

1. Явная проверка на дубликат

If Not dict.Exists(LCase(currentValue)) Then

Вот здесь всё честно и прозрачно. Мы прямо спрашиваем: такого значения уже нет? Если нет — добавляем. Если есть — пропускаем.

Без ловли ошибок. Без молчаливого игнорирования. Без ощущения, что код чуть-чуть «на авось». Это уже более чистый стиль.

2. Можно легко менять логику хранения

Сейчас ключ — это значение в нижнем регистре, а храним мы оригинальное значение. Это полезно, потому что на выходе ты получаешь человеческий вид текста, но сравнение идёт без учёта регистра.

3. Dictionary удобно расширять

Например, позже можно не просто хранить уникальные значения, а ещё и считать, сколько раз каждое встретилось. И вот тут Dictionary раскрывается по-настоящему.

Более сильный сценарий: собрать не просто список, а список с количеством повторений

Вот это уже очень полезная офисная штука.

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

Ниже — рабочий макрос.

Sub СобратьУникальныеЗначенияСПодсчётом()
Dim wsSource As Worksheet*
Dim wsResult As Worksheet*
Dim lastRow As Long*
Dim i As Long*
Dim currentValue As String*
Dim dict As Object*
Dim key As Variant*
Set wsSource = ThisWorkbook.Worksheets("Данные")*
On Error Resume Next*
Set wsResult = ThisWorkbook.Worksheets("Уникальные значения")*
On Error GoTo 0*
If wsResult Is Nothing Then*
Set wsResult = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))*

wsResult.Name = "Уникальные значения"*

Else*
wsResult.Cells.Clear*

End If*
Set dict = CreateObject("Scripting.Dictionary")*
lastRow = wsSource.Cells(wsSource.Rows.Count, 2).End(xlUp).Row*
For i = 2 To lastRow*
currentValue = Trim(wsSource.Cells(i, 2).Value)*

If currentValue <> "" Then*

If dict.Exists(LCase(currentValue)) Then*

dict(LCase(currentValue)) = dict(LCase(currentValue)) + 1*

Else*

dict.Add LCase(currentValue), 1*

End If*

End If*

Next i*
wsResult.Range("A1").Value = "Значение"*
wsResult.Range("B1").Value = "Количество"*
i = 2*
For Each key In dict.Keys*
wsResult.Cells(i, 1).Value = key*

wsResult.Cells(i, 2).Value = dict(key)*

i = i + 1*

Next key*
wsResult.Columns("A:B").AutoFit*
MsgBox "Список и количество повторов сформированы.", vbInformation*
End Sub
Макрос решает

Этот вариант уже очень полезен для аналитики. Читатель начинает видеть, что VBA может не только «отобрать без дублей», но и сразу дать маленькую сводку по массиву данных.

Как изменить этот макрос под свою задачу

Вот где начинается самая практичная часть.

Если нужно собирать не клиентов, а сотрудников

Сейчас берётся столбец B:

lastRow = wsSource.Cells(wsSource.Rows.Count, 2).End(xlUp).RowcurrentValue = Trim(wsSource.Cells(i, 2).Value)

Если сотрудники у тебя в столбце D, меняешь 2 на 4.

Если нужно собирать статусы

Если статусы в столбце F, ставишь 6.

Если нужно брать значения с другого листа

Меняешь имя листа в строке:

Set wsSource = ThisWorkbook.Worksheets("Данные")

Если нужно сохранять исходный регистр первого найденного значения

Текущий макрос уже делает это в варианте с dict.Add LCase(currentValue), currentValue. Это хороший рабочий компромисс: сравниваем без учёта регистра, а выводим нормальный текст.

Если нужно сортировать итоговый список

Список можно после вывода отсортировать отдельным макросом — и вот здесь очень красиво связывается 7 часть с 5 частью серии. Сначала собрали уникальные значения, потом отсортировали их одной кнопкой. Вот это уже прям взрослая сцепка решений.

Где ещё использовать этот подход

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

Для клиентов — чтобы собрать чистую базу.
Для сотрудников — чтобы построить выпадающий список.
Для проектов — чтобы быстро увидеть весь перечень.
Для статусов — чтобы проверить, какие значения реально используются.
Для товаров — чтобы сделать отдельный список номенклатуры.
Для городов — чтобы собрать географию заявок.
Для объектов — чтобы увидеть активные площадки.
Для филиалов — чтобы построить сводную логику.
Для номеров договоров — чтобы проверить уникальность перечня.

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

Маленькая история, которая очень узнаваема

Обычно задача «собрать уникальных клиентов» кажется мелкой. Пока её не начинают делать каждую неделю. Потом оказывается, что на это снова ушло десять минут. Потом ещё десять. Потом кто-то случайно оставил пробел, и один клиент раздвоился. Потом список ушёл в отчёт. Потом кто-то спрашивает, почему в базе два похожих названия. И начинается расследование, которого можно было бы избежать одной кнопкой.

VBA здесь работает очень по-честному. Он не делает ничего «магического». Он просто каждый раз выполняет одну и ту же чистую процедуру одинаково. А одинаковая чистая процедура в офисной жизни — почти как хорошая привычка: снаружи выглядит скромно, а пользы даёт непропорционально много.

Что особенно ценно в этой части серии

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

А 7 часть добавляет к этой системе ещё один важный слой — чистые списки без дублей. Это уже не просто удобство. Это материал для следующей автоматизации.

Из уникальных значений можно строить:

  • выпадающие списки;
  • контрольные таблицы;
  • отчёты;
  • фильтры;
  • справочники;
  • валидацию данных;
  • отдельные мини-дашборды.

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

Вывод

Сильная автоматизация в Excel — это не обязательно сложный код на полэкрана. Очень часто самый полезный сценарий — это тот, который делает скучную повторяющуюся задачу один раз и без мусора. Список уникальных значений как раз из таких.

Он убирает дубли.
Чистит массив.
Помогает строить отчёты и справочники.
Экономит время.
Снижает число мелких ошибок.
И даёт ощущение, что Excel наконец начинает вести себя как помощник, а не как склад случайных строк.

Сохраните статью, если у вас есть таблицы, где постоянно повторяются одни и те же клиенты, сотрудники, статусы или проекты. А файл с готовыми примерами для Collection и Dictionary забирайте в Telegram — там будет рабочая заготовка, которую можно подстроить под любой столбец за пару минут.

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

В следующей части разберём очень сильный практический сценарий: автоматическое сохранение резервной копии файла, чтобы Excel сам делал страховку до того, как кто-то случайно нажмёт не туда или сохранит поверх нужной версии.

Макрос решает