Макрос для excel поиск совпадений

Поиск совпадений в двух списках

Тема сравнения двух списков поднималась уже неоднократно и с разных сторон, но остается одной из самых актуальных везде и всегда. Давайте рассмотрим один из ее аспектов — подсчет количества и вывод совпадающих значений в двух списках. Предположим, что у нас есть два диапазона данных, которые мы хотим сравнить:

Для удобства, можно дать им имена, чтобы потом использовать их в формулах и ссылках. Для этого нужно выделить ячейки с элементами списка и на вкладке Формулы нажать кнопку Менеджер Имен — Создать (Formulas — Name Manager — Create). Также можно превратить таблицы в «умные» с помощью сочетания клавиш Ctrl+T или кнопки Форматировать как таблицу на вкладке Главная (Home — Format as Table).

Подсчет количества совпадений

Для подсчета количества совпадений в двух списках можно использовать следующую элегантную формулу:

В английской версии это будет =SUMPRODUCT(COUNTIF(Список1;Список2))

Давайте разберем ее поподробнее, ибо в ней скрыто пару неочевидных фишек.

Во-первых, функция СЧЁТЕСЛИ (COUNTIF). Обычно она подсчитывает количество искомых значений в диапазоне ячеек и используется в следующей конфигурации:

=СЧЁТЕСЛИ(Где_искать; Что_искать)

Обычно первый аргумент — это диапазон, а второй — ячейка, значение или условие (одно!), совпадения с которым мы ищем в диапазоне. В нашей же формуле второй аргумент — тоже диапазон. На практике это означает, что мы заставляем Excel перебирать по очереди все ячейки из второго списка и подсчитывать количество вхождений каждого из них в первый список. По сути, это равносильно целому столбцу дополнительных вычислений, свернутому в одну формулу:

Во-вторых, функция СУММПРОИЗВ (SUMPRODUCT) здесь выполняет две функции — суммирует вычисленные СЧЁТЕСЛИ совпадения и заодно превращает нашу формулу в формулу массива без необходимости нажимать сочетание клавиш Ctrl+Shift+Enter. Формула массива необходима, чтобы функция СЧЁТЕСЛИ в режиме с двумя аргументами-диапазонами корректно отработала свою задачу.

Вывод списка совпадений формулой массива

Если нужно не просто подсчитать количество совпадений, но и вывести совпадающие элементы отдельным списком, то потребуется не самая простая формула массива:

В английской версии это будет, соответственно:

=INDEX(Список1;MATCH(1;COUNTIF(Список2;Список1)*NOT(COUNTIF($E$1:E1;Список1));0))

Логика работы этой формулы следующая:

• фрагмент СЧЁТЕСЛИ(Список2;Список1), как и в примере до этого, ищет совпадения элементов из первого списка во втором
• фрагмент НЕ(СЧЁТЕСЛИ($E$1:E1;Список1)) проверяет, не найдено ли уже текущее совпадение выше
• и, наконец, связка функций ИНДЕКС и ПОИСКПОЗ извлекает совпадающий элемент

Не забудьте в конце ввода этой формулы нажать сочетание клавиш Ctrl+Shift+Enter, т.к. она должна быть введена как формула массива.

Возникающие на избыточных ячейках ошибки #Н/Д можно дополнительно перехватить и заменить на пробелы или пустые строки «» с помощью функции ЕСЛИОШИБКА (IFERROR).

Вывод списка совпадений с помощью слияния запросов Power Query

На больших таблицах формула массива из предыдущего способа может весьма ощутимо тормозить, поэтому гораздо удобнее будет использовать Power Query. Это бесплатная надстройка от Microsoft, способная загружать в Excel 2010-2013 и трансформировать практически любые данные. Мощь и возможности Power Query так велики, что Microsoft включила все ее функции по умолчанию в Excel начиная с 2016 версии. 

Для начала, нам необходимо загрузить наши таблицы в Power Query. Для этого выделим первый список и на вкладке Данные (в Excel 2016) или на вкладке Power Query (если она была установлена как отдельная надстройка в Excel 2010-2013) жмем кнопку Из таблицы/диапазона (From Table):

Excel превратит нашу таблицу в «умную» и даст ей типовое имя Таблица1. После чего данные попадут в редактор запросов Power Query. Никаких преобразований с таблицей нам делать не нужно, поэтому можно смело жать в левом верхнем углу кнопку Закрыть и загрузить — Закрыть и загрузить в… (Close & Load To…) и выбрать в появившемся окне Только создать подключение (Create only connection):

Затем повторяем то же самое со вторым диапазоном.

И, наконец, переходим с выявлению совпадений. Для этого на вкладке Данные или на вкладке Power Query находим команду Получить данные — Объединить запросы — Объединить (Get Data — Merge Queries — Merge):

В открывшемся окне делаем три вещи:

1. выбираем наши таблицы из выпадающих списков
2. выделяем столбцы, по которым идет сравнение
3. выбираем Тип соединения = Внутреннее (Inner Join)

После нажатия на ОК на экране останутся только совпадающие строки:

Ненужный столбец Таблица2 можно правой кнопкой мыши удалить, а заголовок первого столбца переименовать во что-то более понятное (например Совпадения). А затем выгрузить полученную таблицу на лист, используя всё ту же команду Закрыть и загрузить (Close & Load):

Если значения в исходных таблицах в будущем будут изменяться, то необходимо не забыть обновить результирующий список совпадений правой кнопкой мыши или сочетанием клавиш Ctrl+Alt+F5. 

Макрос для вывода списка совпадений

Само-собой, для решения задачи поиска совпадений можно воспользоваться и макросом. Для этого нажмите кнопку Visual Basic на вкладке Разработчик (Developer). Если ее не видно, то отобразить ее можно через Файл — Параметры — Настройка ленты (File — Options — Customize Ribbon).

В окне редактора Visual Basic нужно добавить новый пустой модуль через меню Insert — Module и затем скопировать туда код нашего макроса:

Sub Find_Matches_In_Two_Lists()
    Dim coll As New Collection
    Dim rng1 As Range, rng2 As Range, rngOut As Range
    Dim i As Long, j As Long, k As Long

    Set rng1 = Selection.Areas(1)
    Set rng2 = Selection.Areas(2)
    Set rngOut = Application.InputBox(Prompt:="Выделите ячейку, начиная с которой нужно вывести совпадения", Type:=8)

    'загружаем первый диапазон в коллекцию
    For i = 1 To rng1.Cells.Count
        coll.Add rng1.Cells(i), CStr(rng1.Cells(i))
    Next i
    
    'проверяем вхождение элементов второго диапазона в коллекцию
    k = 0
    On Error Resume Next
    For j = 1 To rng2.Cells.Count
        Err.Clear
        elem = coll.Item(CStr(rng2.Cells(j)))
        If CLng(Err.Number) = 0 Then
            'если найдено совпадение, то выводим со сдвигом вниз
            rngOut.Offset(k, 0) = rng2.Cells(j)
            k = k + 1
        End If
    Next j
End Sub

Воспользоваться добавленным макросом очень просто. Выделите, удерживая клавишу Ctrl, оба диапазона и запустите макрос кнопкой Макросы на вкладке Разработчик (Developer) или сочетанием клавиш Alt+F8. Макрос попросит указать ячейку, начиная с которой нужно вывести список совпадений и после нажатия на ОК сделает всю работу:

Более совершенный макрос подобного типа есть, кстати, в моей надстройке PLEX для Microsoft Excel.

Ссылки по теме

• Поиск различий в двух списках Excel
• Слияние двух списков без дубликатов (3 способа)
• Что такое макросы, как их использовать, куда копировать код макросов на Visual Basic

Based on Ahmed’s answer, after some cleaning up and generalization, including the other «Find» parameters, so we can use this function in any situation:

'Uses Range.Find to get a range of all find results within a worksheet
' Same as Find All from search dialog box
'
Function FindAll(rng As Range, What As Variant, Optional LookIn As XlFindLookIn = xlValues, Optional LookAt As XlLookAt = xlWhole, Optional SearchOrder As XlSearchOrder = xlByColumns, Optional SearchDirection As XlSearchDirection = xlNext, Optional MatchCase As Boolean = False, Optional MatchByte As Boolean = False, Optional SearchFormat As Boolean = False) As Range
    Dim SearchResult As Range
    Dim firstMatch As String
    With rng
        Set SearchResult = .Find(What, , LookIn, LookAt, SearchOrder, SearchDirection, MatchCase, MatchByte, SearchFormat)
        If Not SearchResult Is Nothing Then
            firstMatch = SearchResult.Address
            Do
                If FindAll Is Nothing Then
                    Set FindAll = SearchResult
                Else
                    Set FindAll = Union(FindAll, SearchResult)
                End If
                Set SearchResult = .FindNext(SearchResult)
            Loop While Not SearchResult Is Nothing And SearchResult.Address <> firstMatch
        End If
    End With
End Function

Usage is the same as native .Find, but here is a usage example as requested:

Sub test()
  Dim SearchRange As Range, SearchResults As Range, rng As Range
    Set SearchRange = MyWorksheet.UsedRange
    Set SearchResults = FindAll(SearchRange, "Search this")
    
    If SearchResults Is Nothing Then
        'No match found
    Else
        For Each rng In SearchResults
            'Loop for each match
        Next
    End If
End Sub