Как написать VBA-макрос который находит и удаляет дубликаты в таблице Excel автоматически — с разбором кода, готовым примером и кнопкой запуска.
Представьте: таблица на 3 000 строк, данные собраны из трёх источников, и где-то внутри — дубликаты. Одни и те же клиенты, заказы, артикулы — записаны дважды или трижды. Итоговая сумма врёт. Отчёт врёт. И вы об этом не знаете.
Стандартный путь — вкладка «Данные», кнопка «Удалить дубликаты». Работает. Но только если дубль — это точное совпадение всей строки. Стоит одному полю отличаться — пробел лишний, заглавная буква, дата в другом формате — и Excel дубль не видит.
Макрос работает иначе. Вы сами указываете по какому столбцу искать совпадения. Остальное он делает сам — находит, помечает, удаляет. За секунду. На любом объёме.
В этой статье разберём как написать такой макрос с нуля, что происходит внутри кода, и как привязать его к кнопке чтобы запускать в один клик.
Почему стандартный инструмент не всегда справляется
Excel умеет удалять дубликаты встроенным способом. Вкладка «Данные» → «Удалить дубликаты» → выбрать столбцы → ОК. Быстро и удобно.
Но у этого подхода есть три слабых места.
- Первое — он удаляет строки сразу, без возможности сначала посмотреть что именно будет удалено. Вы нажали — строки исчезли. Если что-то пошло не так, только Ctrl+Z спасает.
- Второе — он не гибкий. Нельзя удалять дубли только в определённом диапазоне, пропускать первые несколько строк или работать по условию. Либо всё, либо ничего.
- Третье — каждый раз нужно проходить через меню заново. Если таблица обновляется каждый день, это превращается в рутину.
Макрос закрывает все три проблемы. Он показывает что найдено, работает по вашим правилам и запускается одной кнопкой.
Что нам понадобится перед стартом
Прежде чем писать код, нужно убедиться что макросы в Excel включены. По умолчанию они заблокированы из соображений безопасности.
Откройте Excel. Перейдите в «Файл» → «Параметры» → «Центр управления безопасностью» → «Параметры центра управления безопасностью» → «Параметры макросов». Выберите «Включить все макросы» или «Включить макросы с уведомлением».
Второй момент — формат файла. Файлы с макросами сохраняются только в формате .xlsm. Если попробуете сохранить как .xlsx, Excel предупредит что макрос будет удалён.
Чтобы открыть редактор VBA: нажмите Alt+F11. Откроется отдельное окно — Visual Basic for Applications. Именно здесь пишется весь код.
Если вкладки «Разработчик» нет на ленте — включите её через «Файл» → «Параметры» → «Настроить ленту» → поставьте галочку напротив «Разработчик».
Пишем макрос: простая версия
Начнём с базового варианта. Макрос ищет дубли в первом столбце и удаляет строки с повторами, оставляя только первое вхождение.
Откройте редактор VBA через Alt+F11. В левой панели найдите «Эта книга» или любой из листов. Нажмите правой кнопкой → «Вставить» → «Модуль». Откроется пустое поле для кода.
Вставьте следующий код:
Sub УдалитьДубли()
Dim ws As Worksheet*
Dim lastRow As Long*
Dim i As Long*
Dim checkCol As Integer*
Dim dict As Object*
Dim cellValue As String*
Set ws = ActiveSheet*
checkCol = 1*
lastRow = ws.Cells(ws.Rows.Count, checkCol).End(xlUp).Row*
Set dict = CreateObject("Scripting.Dictionary")*
For i = lastRow To 2 Step -1*
cellValue = Trim(LCase(ws.Cells(i, checkCol).Value))*
If dict.exists(cellValue) Then*
ws.Rows(i).Delete*
Else*
dict.Add cellValue, 1*
End If*
Next i*
MsgBox "Готово. Дубликаты удалены.", vbInformation*
End Sub
Нажмите F5 или кнопку «Запустить» — макрос выполнится на активном листе.
Что происходит внутри кода
Разберём каждый блок чтобы вы понимали логику, а не просто копировали код.
Dim ws As Worksheet — объявляем переменную для листа. Set ws = ActiveSheet — говорим макросу работать с тем листом, который сейчас открыт.
checkCol = 1 — указываем номер столбца для проверки. Единица означает первый столбец, то есть столбец A. Если нужно проверять по столбцу B — поставьте 2, по столбцу C — 3.
lastRow = ws.Cells(ws.Rows.Count, checkCol).End(xlUp).Row — находим последнюю заполненную строку в столбце. Это стандартный приём VBA, который работает надёжнее чем просто указать фиксированное число строк.
Set dict = CreateObject("Scripting.Dictionary") — создаём словарь. Это специальная структура данных которая хранит уникальные значения. Именно с её помощью макрос запоминает что уже встречал.
For i = lastRow To 2 Step -1 — цикл идёт снизу вверх. Это важно: если удалять строки сверху вниз, индексы сдвигаются и макрос пропускает строки. Движение снизу вверх эту проблему исключает. Цикл начинается со второй строки чтобы не трогать заголовок.
cellValue = Trim(LCase(...)) — приводим значение к нижнему регистру и убираем лишние пробелы. Благодаря этому «Иванов», «иванов» и « Иванов » считаются одним и тем же значением.
If dict.exists(cellValue) Then ws.Rows(i).Delete — если значение уже есть в словаре, строка удаляется. Если нет — добавляем в словарь и идём дальше.
Улучшенная версия: сначала показать, потом удалить
Удалять сразу — рискованно. Особенно если таблица важная. Добавим шаг: сначала макрос подсвечивает дубли цветом, и только после вашего подтверждения удаляет их.
Sub НайтиИУдалитьДубли()
Dim ws As Worksheet*
Dim lastRow As Long*
Dim i As Long*
Dim checkCol As Integer*
Dim dict As Object*
Dim cellValue As String*
Dim dubCount As Long*
Dim answer As Integer*
Set ws = ActiveSheet*
checkCol = 1*
lastRow = ws.Cells(ws.Rows.Count, checkCol).End(xlUp).Row*
Set dict = CreateObject("Scripting.Dictionary")*
dubCount = 0*
ws.Cells.Interior.ColorIndex = xlNone*
For i = 2 To lastRow*
cellValue = Trim(LCase(ws.Cells(i, checkCol).Value))*
If dict.exists(cellValue) Then*
ws.Rows(i).Interior.Color = RGB(255, 200, 200)*
dubCount = dubCount + 1*
Else*
dict.Add cellValue, 1*
End If*
Next i*
If dubCount = 0 Then*
MsgBox "Дубликатов не найдено.", vbInformation*
Exit Sub*
End If*
answer = MsgBox("Найдено дубликатов: " & dubCount & ". Удалить их?", vbYesNo + vbQuestion)*
If answer = vbYes Then*
For i = lastRow To 2 Step -1*
If ws.Rows(i).Interior.Color = RGB(255, 200, 200) Then*
ws.Rows(i).Delete*
End If*
Next i*
MsgBox "Готово. Удалено строк: " & dubCount, vbInformation*
Else*
ws.Cells.Interior.ColorIndex = xlNone*
MsgBox "Удаление отменено. Подсветка снята.", vbInformation*
End If*
End Sub
Теперь макрос сначала красит дубли в розовый цвет и показывает их количество. Вы смотрите, убеждаетесь что всё правильно, и только потом подтверждаете удаление. Если передумали — нажимаете «Нет», подсветка снимается, таблица остаётся нетронутой.
Версия с выбором столбца
Если столбец для проверки меняется от таблицы к таблице, удобнее не лезть в код каждый раз, а выбирать столбец через диалоговое окно.
Sub УдалитьДублиВыборСтолбца()
Dim ws As Worksheet*
Dim lastRow As Long*
Dim i As Long*
Dim checkCol As Integer*
Dim dict As Object*
Dim cellValue As String*
Dim colInput As String*
colInput = InputBox("Введите номер столбца для проверки (1 = A, 2 = B и т.д.):", "Выбор столбца", "1")*
If colInput = "" Then Exit Sub*
If Not IsNumeric(colInput) Then*
MsgBox "Введите число.", vbExclamation*
Exit Sub*
End If*
checkCol = CInt(colInput)*
Set ws = ActiveSheet*
lastRow = ws.Cells(ws.Rows.Count, checkCol).End(xlUp).Row*
Set dict = CreateObject("Scripting.Dictionary")*
For i = lastRow To 2 Step -1*
cellValue = Trim(LCase(ws.Cells(i, checkCol).Value))*
If dict.exists(cellValue) Then*
ws.Rows(i).Delete*
Else*
dict.Add cellValue, 1*
End If*
Next i*
MsgBox "Готово. Дубликаты по столбцу " & checkCol & " удалены.", vbInformation*
End Sub
При запуске появится окно с просьбой ввести номер столбца. Ввели 3 — макрос проверяет столбец C. Удобно когда структура таблиц разная.
Как привязать макрос к кнопке
Запускать макрос через Alt+F8 каждый раз — неудобно. Гораздо лучше — кнопка прямо на листе.
Перейдите на вкладку «Разработчик». Нажмите «Вставить» → в разделе «Элементы управления формы» выберите «Кнопка». Нарисуйте кнопку на листе — зажмите левую кнопку мыши и растяните прямоугольник нужного размера.
Сразу после того как отпустите кнопку мыши, появится диалог «Назначить макрос». Выберите из списка нужный макрос — например НайтиИУдалитьДубли — и нажмите ОК.
Чтобы переименовать кнопку: нажмите на неё правой кнопкой мыши → «Изменить текст». Напишите, например, «Удалить дубли».
Теперь кнопка работает. Один клик — и макрос запущен.
Если хотите кнопку покрасивее — используйте не «Элементы управления формы», а «Элементы ActiveX». Там больше настроек внешнего вида: цвет, шрифт, размер. Но для базовой задачи обычная кнопка формы подходит отлично.
Частые ошибки и как их избежать
Макрос удалил нужные строки. Причина — данные в столбце выглядят одинаково, но по смыслу разные. Например, два клиента с одинаковой фамилией. Решение — проверять не по одному столбцу, а по комбинации: фамилия + дата рождения, артикул + склад.
Макрос не видит дубли которые явно есть. Причина — лишние пробелы или разный регистр. В коде уже есть Trim и LCase которые это исправляют. Но если в ячейках есть непечатаемые символы — добавьте Clean: cellValue = Trim(LCase(Clean(ws.Cells(i, checkCol).Value))).
Ошибка «Subscript out of range». Макрос не может найти лист. Проверьте что активный лист — именно тот который нужно. Или замените ActiveSheet на конкретное имя: Set ws = Sheets("Данные").
Макрос работает медленно на большой таблице. Добавьте в начало кода отключение обновления экрана:
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
И в конце перед MsgBox верните обратно:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
На таблицах в 10 000+ строк это ускоряет работу в несколько раз.
Как проверить работу макроса перед боевым использованием
Никогда не запускайте новый макрос на оригинальном файле. Сделайте копию — просто сохраните файл под другим именем — и тестируйте на ней.
Для теста создайте небольшую таблицу на 10–15 строк где дубли расставлены заранее и вы точно знаете что должно остаться. Запустите макрос, проверьте результат. Если всё совпало — можно работать с реальными данными.
Если что-то пошло не так — Ctrl+Z отменяет последнее действие макроса пока файл не закрыт. После закрытия отмена уже недоступна, поэтому копия файла перед запуском — обязательное правило.
Что дальше
Удаление дублей — одна из самых частых задач автоматизации в Excel. Но макрос можно сделать умнее: искать дубли сразу по нескольким столбцам, переносить их на отдельный лист вместо удаления, или формировать отчёт о найденных совпадениях.
Если вам интересно как собрать данные из нескольких листов в одну таблицу — читайте статью Кнопка, которая собирает данные из всех листов Excel в одну таблицу.
А как автоматически найти и подсветить ошибки в таблице — в статье Найдите ошибки в Excel одной кнопкой — VBA сам подсветит проблемные ячейки.
Подписывайтесь на канал в Telegram — там короткие гайды, готовые файлы и разборы задач которые реально встречаются в работе: t.me/macroschannel
Итог
Макрос для удаления дублей — это не замена встроенному инструменту Excel, а его усиление. Он работает по вашим правилам, показывает что нашёл до удаления, и запускается одной кнопкой.
Три варианта кода в статье закрывают разные сценарии: быстрое удаление, удаление с подтверждением, выбор столбца через диалог. Берите тот который подходит под вашу задачу.
Главное правило — копия файла перед запуском. Всегда.