Как написать VBA-макрос для умного поиска в таблице Excel — поиск по нескольким столбцам одновременно, подсветка результатов и вывод в отдельный список с разбором кода.
Макрос находит нужную строку в Excel быстрее чем Ctrl+F — умный поиск по нескольким условиям
Ctrl+F — стандартный поиск в Excel — ищет по одному слову во всей книге. Нашёл совпадение, показал ячейку, жди следующего нажатия. Если нужно найти строки где одновременно выполняются два условия — например регион «Москва» и статус «Просрочено» — стандартный поиск не поможет. Придётся фильтровать вручную, снимать фильтры, снова фильтровать.
Макрос умного поиска работает иначе. Вы указываете критерии — по одному или нескольким столбцам — и он за секунду находит все строки которые им соответствуют. Подсвечивает их прямо в таблице, выводит в отдельный список или просто показывает количество результатов. Без ручной фильтрации, без потери форматирования, без риска случайно что-то удалить.
В этой статье напишем такой макрос с нуля, разберём как он работает и добавим несколько полезных вариаций под разные задачи.
Чем умный поиск лучше стандартных инструментов
В Excel есть три встроенных инструмента для поиска данных: Ctrl+F, автофильтр и функции типа ВПР. У каждого есть ограничения которые макрос снимает.
Ctrl+F ищет одно значение и останавливается на первом совпадении. Каждый следующий результат требует ещё одного нажатия. Нельзя искать по нескольким условиям одновременно. Нельзя автоматически выделить все найденные строки разом.
Автофильтр работает хорошо но меняет вид таблицы. Часть строк скрывается. Если нужно видеть и исходную таблицу и результаты одновременно — не вариант. Плюс каждый раз нужно вручную выбирать критерии через интерфейс.
ВПР и ИНДЕКС+ПОИСКПОЗ возвращают одно значение из найденной строки. Они не показывают все строки с совпадением, не подсвечивают их и не выводят как список. Подробнее об этих функциях — в статье ИНДЕКС + ПОИСКПОЗ в Excel: профессиональная подстановка данных.
Макрос умного поиска объединяет лучшее от всех трёх инструментов и добавляет то чего в них нет: поиск по нескольким критериям, подсветку всех результатов одновременно и вывод в отдельный лист.
Подготовка к написанию кода
Стандартные требования для любого VBA-макроса.
Макросы должны быть включены: Файл → Параметры → Центр управления безопасностью → Параметры макросов → Включить все макросы. Файл сохраняется в формате .xlsm — без этого макрос не сохранится.
Открыть редактор VBA: Alt+F11. В левой панели правая кнопка на книге → Вставить → Модуль. В пустом поле будет написан код.
Для полноценной работы макроса поиска нужна таблица с заголовками в первой строке и данными начиная со второй. Структура заголовков должна быть одинаковой и без объединённых ячеек в строке заголовков.
Простая версия — поиск по одному столбцу с подсветкой
Начнём с базового варианта. Макрос запрашивает поисковый запрос через диалоговое окно, ищет его в указанном столбце и подсвечивает все найденные строки.
Sub УмныйПоиск()
Dim ws As Worksheet*
Dim lastRow As Long*
Dim i As Long*
Dim searchCol As Integer*
Dim searchText As String*
Dim found As Long*
Set ws = ActiveSheet*
searchCol = 2 ' Столбец для поиска (2 = столбец B)*
' Запрашиваем поисковый запрос*
searchText = InputBox("Введите текст для поиска:", "Умный поиск", "")*
If searchText = "" Then Exit Sub*
' Снимаем предыдущую подсветку*
ws.Cells.Interior.ColorIndex = xlNone*
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row*
found = 0*
' Ищем по каждой строке*
For i = 2 To lastRow*
If InStr(1, LCase(ws.Cells(i, searchCol).Value), LCase(searchText)) > 0 Then*
ws.Rows(i).Interior.Color = RGB(255, 235, 59) ' Жёлтая подсветка*
found = found + 1*
End If*
Next i*
If found = 0 Then*
MsgBox "Ничего не найдено по запросу: " & searchText, vbInformation*
Else*
MsgBox "Найдено строк: " & found, vbInformation*
End If*
End Sub
Запустите макрос через Alt+F8 → выберите «УмныйПоиск» → запустить. Появится окно для ввода запроса. Введите любое слово — макрос подсветит все строки где это слово встречается в столбце B.
Что происходит в каждой строке кода
Разбираем логику чтобы вы могли адаптировать код под свою задачу.
searchCol = 2 — номер столбца в котором ищем. 2 — это столбец B. Измените на нужный номер: 1 — столбец A, 3 — столбец C и так далее.
searchText = InputBox(...) — диалоговое окно для ввода поискового запроса. Если пользователь нажал «Отмена» или ничего не ввёл — переменная будет пустой строкой, и макрос завершится через If searchText = "" Then Exit Sub.
ws.Cells.Interior.ColorIndex = xlNone — снимаем подсветку с предыдущего поиска. Без этой строки результаты разных поисков будут накапливаться.
InStr(1, LCase(...), LCase(searchText)) > 0 — ключевое условие поиска. Функция InStr ищет одну строку внутри другой и возвращает позицию первого совпадения или 0 если не нашла. LCase приводит оба значения к нижнему регистру — это делает поиск нечувствительным к регистру. «Москва», «москва» и «МОСКВА» будут найдены одинаково.
ws.Rows(i).Interior.Color = RGB(255, 235, 59) — красим всю строку в жёлтый цвет. RGB задаёт цвет через красный, зелёный и синий компоненты. Для красного: RGB(255, 205, 210). Для зелёного: RGB(200, 230, 200). Для голубого: RGB(187, 222, 251).
Версия с поиском по нескольким столбцам
Более мощный вариант. Пользователь вводит несколько критериев и макрос находит строки где выполняются все условия одновременно — логика «И».
Sub УмныйПоискПоНескольким()
Dim ws As Worksheet*
Dim lastRow As Long*
Dim i As Long*
Dim found As Long*
Dim критерий1 As String*
Dim критерий2 As String*
Dim критерий3 As String*
Set ws = ActiveSheet*
' Запрашиваем критерии*
критерий1 = InputBox("Критерий 1 — Регион (оставьте пустым чтобы пропустить):", "Поиск", "")*
критерий2 = InputBox("Критерий 2 — Статус (оставьте пустым чтобы пропустить):", "Поиск", "")*
критерий3 = InputBox("Критерий 3 — Ответственный (оставьте пустым чтобы пропустить):", "Поиск", "")*
' Если все критерии пустые — выходим*
If критерий1 = "" And критерий2 = "" And критерий3 = "" Then*
MsgBox "Не введено ни одного критерия.", vbExclamation*
Exit Sub*
End If*
ws.Cells.Interior.ColorIndex = xlNone*
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row*
found = 0*
For i = 2 To lastRow*
Dim совпадение1 As Boolean*
Dim совпадение2 As Boolean*
Dim совпадение3 As Boolean*
' Проверяем каждый критерий — пустой критерий считается выполненным*
совпадение1 = (критерий1 = "") Or (InStr(1, LCase(ws.Cells(i, 2).Value), LCase(критерий1)) > 0)*
совпадение2 = (критерий2 = "") Or (InStr(1, LCase(ws.Cells(i, 3).Value), LCase(критерий2)) > 0)*
совпадение3 = (критерий3 = "") Or (InStr(1, LCase(ws.Cells(i, 4).Value), LCase(критерий3)) > 0)*
' Подсвечиваем только если выполнены все условия*
If совпадение1 And совпадение2 And совпадение3 Then*
ws.Rows(i).Interior.Color = RGB(255, 235, 59)*
found = found + 1*
End If*
Next i*
If found = 0 Then*
MsgBox "Ничего не найдено.", vbInformation*
Else*
MsgBox "Найдено строк: " & found, vbInformation*
End If*
End Sub
Если пользователь оставил критерий пустым — он не учитывается. Ввёл только регион — ищет по региону. Ввёл регион и статус — ищет строки где совпадают оба. Это гибкий поиск который работает с любым количеством активных условий.
Числа столбцов в строках совпадение1, совпадение2, совпадение3 меняйте под свою структуру таблицы. Сейчас: 2 — столбец B, 3 — столбец C, 4 — столбец D.
Версия с выводом результатов на отдельный лист
Иногда нужно не просто подсветить строки а скопировать их на отдельный лист для дальнейшей работы. Этот вариант создаёт лист «Результаты» и копирует туда все найденные строки.
Sub ПоискСВыводом()
Dim wsИсточник As Worksheet*
Dim wsРезультаты As Worksheet*
Dim lastRow As Long*
Dim i As Long*
Dim rowРезультат As Long*
Dim searchText As String*
Dim searchCol As Integer*
Set wsИсточник = ActiveSheet*
searchCol = 2*
searchText = InputBox("Введите текст для поиска:", "Поиск с выводом", "")*
If searchText = "" Then Exit Sub*
' Создаём или очищаем лист результатов*
On Error Resume Next*
Set wsРезультаты = Sheets("Результаты")*
On Error GoTo 0*
If wsРезультаты Is Nothing Then*
Set wsРезультаты = Sheets.Add(After:=Sheets(Sheets.Count))*
wsРезультаты.Name = "Результаты"*
Else*
wsРезультаты.Cells.Clear*
End If*
' Копируем заголовки*
wsИсточник.Rows(1).Copy wsРезультаты.Rows(1)*
rowРезультат = 2*
lastRow = wsИсточник.Cells(wsИсточник.Rows.Count, 1).End(xlUp).Row*
For i = 2 To lastRow*
If InStr(1, LCase(wsИсточник.Cells(i, searchCol).Value), LCase(searchText)) > 0 Then*
wsИсточник.Rows(i).Copy wsРезультаты.Rows(rowРезультат)*
rowРезультат = rowРезультат + 1*
End If*
Next i*
If rowРезультат = 2 Then*
MsgBox "Ничего не найдено по запросу: " & searchText, vbInformation*
Application.DisplayAlerts = False*
wsРезультаты.Delete*
Application.DisplayAlerts = True*
Else*
wsРезультаты.Activate*
MsgBox "Найдено и скопировано строк: " & (rowРезультат - 2), vbInformation*
End If*
End Sub
После запуска появляется лист «Результаты» с заголовками и всеми найденными строками. Форматирование из исходной таблицы сохраняется. Если ничего не найдено — лист удаляется автоматически.
Поиск с точным совпадением против частичного
В базовой версии InStr ищет вхождение — то есть «Моск» найдёт и «Москва», и «Подмосковье». Иногда нужно точное совпадение.
Для точного совпадения замените строку с InStr на прямое сравнение:
If LCase(ws.Cells(i, searchCol).Value) = LCase(searchText) Then
Это найдёт строки где значение в ячейке точно совпадает с поисковым запросом. «Москва» не найдёт «Подмосковье».
Для поиска по числовому диапазону — например все строки где значение в столбце больше 1000:
Dim threshold As Double
threshold = CDbl(InputBox("Найти строки где значение больше:", "Числовой поиск", "0"))
For i = 2 To lastRow
If IsNumeric(ws.Cells(i, searchCol).Value) Then*
If ws.Cells(i, searchCol).Value > threshold Then*
ws.Rows(i).Interior.Color = RGB(255, 235, 59)*
found = found + 1*
End If*
End If*
Next i
IsNumeric проверяет что в ячейке действительно число а не текст — это защищает от ошибок при сравнении.
Как снять подсветку одной кнопкой
После поиска нужен быстрый способ вернуть таблицу в исходный вид. Короткий макрос снимает всю подсветку.
Sub СнятьПодсветку()
ActiveSheet.Cells.Interior.ColorIndex = xlNone*
MsgBox "Подсветка снята.", vbInformation*
End Sub
Привяжите оба макроса — «УмныйПоиск» и «СнятьПодсветку» — к двум кнопкам прямо на листе. Вкладка «Разработчик» → Вставить → Кнопка. Один клик ищет, другой — возвращает таблицу к обычному виду.
Перелинковка — связанные материалы
Умный поиск удобен как самостоятельный инструмент, но ещё лучше работает в паре с другими макросами. Если нужно после поиска подсветить ошибки в найденных строках — читайте Найдите ошибки в Excel одной кнопкой — VBA сам подсветит проблемные ячейки. Как собрать данные из нескольких листов перед поиском — в статье Кнопка, которая собирает данные из всех листов Excel в одну таблицу.
Если хотите искать данные формулами без макросов — разберите ПОИСКПОЗ в Excel: как находить строки и управлять подстановками. А для поиска с гибкими условиями формулами — ИНДЕКС + ПОИСКПОЗ в Excel.
Подписывайтесь на Telegram — там каждый день практичные разборы Excel и VBA с готовыми файлами: t.me/macroschannel
Частые ошибки и как их исправить
Макрос подсвечивает не те строки. Проверьте номер столбца в переменной searchCol. Столбцы считаются слева: A = 1, B = 2, C = 3. Если структура таблицы другая — поменяйте число.
Поиск не находит значение которое явно есть. Скорее всего в ячейке есть лишние пробелы. Добавьте Trim к значению ячейки: Trim(ws.Cells(i, searchCol).Value). Это уберёт пробелы в начале и конце строки перед сравнением.
Ошибка при запуске версии с выводом на лист. Возможно лист «Результаты» уже существует и защищён. Проверьте что у листа нет защиты, или измените название результирующего листа в коде.
Подсветка не снимается при повторном поиске. Убедитесь что строка ws.Cells.Interior.ColorIndex = xlNone стоит до цикла поиска. Если её нет — добавьте.
Макрос работает медленно на большой таблице. Добавьте в начало отключение обновления экрана:
Application.ScreenUpdating = False
И в конце перед MsgBox верните обратно:
Application.ScreenUpdating = True
На таблицах в 5 000+ строк это ускоряет поиск в несколько раз.
Связанные инструменты автоматизации
Умный поиск — часть системы автоматизации Excel. Если хотите защитить найденные ячейки от случайного редактирования — читайте как настроить защиту листа с исключениями через макрос. Как удалить дубли которые нашёл поиск — в статье про макрос удаления дублей. А какие ещё приёмы реально экономят время в Excel — в подборке 5 приёмов Excel которые экономят 5 часов в неделю.
Подписывайтесь на Telegram — там короткие разборы, готовые файлы и реальные задачи по Excel и VBA каждый день: t.me/macroschannel
Итог
Умный поиск через VBA закрывает задачи которые стандартный Ctrl+F и автофильтр решают неудобно. Поиск по нескольким критериям одновременно, подсветка всех результатов разом, вывод на отдельный лист — всё это в одном макросе.
Три версии кода в статье покрывают разные сценарии: простой поиск по одному столбцу, многокритериальный поиск с логикой «И», вывод результатов на отдельный лист. Начните с простой версии, проверьте на копии файла, потом адаптируйте под свою таблицу.
Главное правило — тестировать на копии. Макрос меняет форматирование ячеек. Если что-то пошло не так — Ctrl+Z отменит последнее действие пока файл открыт.