Макросы для 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

This is the ultimate Lookup Macro for Excel. It will search every worksheet in the workbook and return all of the matching results to a single worksheet. You do not have to specify a specific lookup_table and the data can be located anywhere on the worksheets and it will still be found and returned with this macro.

Sub Return_Results_Entire_Workbook()

'This does not search the worksheet that will contain the results of the search

' ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
' ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
' ||||||||||||||||||| ------------ TeachExcel.com -------------- |||||||||||||||||||||||||
' ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
' ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||

'Number for the worksheet that contains the value for which to search
searchValueSheet = "Sheet1"

'Get the value for which we need to search into the macro
searchValue = Sheets(searchValueSheet).Range("A2").Value

'how many columns to the right of any "found" value that you want to use to return the data
returnValueOffset = 1

'The sheet where the results should be placed
outputValueSheet = "Sheet1"

'The column in the sheet where the results should be placed
outputValueCol = 2

'The row in the sheet where the results should be placed
'everything from this row down must be empty!
outputValueRow = 2

'clear the results display area
Sheets(outputValueSheet).Range(Cells(outputValueRow, outputValueCol), Cells(Rows.Count, outputValueCol)).Clear


'count the worksheets in the workbook
wsCount = ActiveWorkbook.Worksheets.Count

'loop through the worksheets in the workbook
For i = 1 To wsCount
    
    'Don't search the sheet with the lookup value or returned values - assumes source data will be on other tabs.
    If i <> Sheets(searchValueSheet).Index And i <> Sheets(outputValueSheet).Index Then
    
        'Perform the search, which is a two-step process below
        Set Rng = Worksheets(i).Cells.Find(What:=searchValue, _
                LookIn:=xlValues, _
                LookAt:=xlWhole, _
                SearchOrder:=xlByRows, _
                SearchDirection:=xlNext, _
                MatchCase:=False)
                
        If Not Rng Is Nothing Then
        
            rangeLoopAddress = Rng.Address
            
            Do
                Set Rng = Sheets(i).Cells.FindNext(Rng)
                Sheets(outputValueSheet).Cells(Cells(Rows.Count, outputValueCol).End(xlUp).Row + 1, outputValueCol).Value = Sheets(i).Range(Rng.Address).Offset(0, returnValueOffset).Value
            Loop While Not Rng Is Nothing And Rng.Address <> rangeLoopAddress
            
        End If
    
    End If

Next i


End Sub 

The code above may seem confusing but you really only have to change a few things to get it to work with your data.

You will have to tell the macro which worksheet contains the value you are searching for, where that search value is located, on which worksheet you want to return the data once it is found and where within that worksheet you want to display the data.

First, change the searchValueSheet to the name of the worksheet that contains the value for which you want to search, the searchValue.

The searchValue is the cell reference of the cell that is used to locate the data to return. Change A2 to the reference of the cell that contains the value you are searching for or the cell where you will input that value. Remember, this cell should be located on the searchValueSheet mentioned above.

The returnValueOffset is a very important value. This tells the macro how far to the right to go to find the data that you want to return once a match for the searchValue has been found. Note that the returned data must come from the same row as the data that matches the searchValue.

The outputValueSheet is the name of the worksheet where you want to return the data. Change the name from Sheet1 to whatever you need. This can be the same as the searchValueSheet or different, it doesn’t matter.

The outputValueCol is the column where you want to display the results within the outputValueSheet

The outputValueRow is the first row in which the returned results should be displayed in the outputValueCol on the outputValueSheet.

Anothing important thing to note is that this macro will NOT search through the worksheets that are referenced by the searchValueSheet or the outputValueSheet. This should not usually matter but, if it does, the easiest solution is to create a specific «Search» tab and set the macro to return everything there.

It may seem like a lot to change, but at least I made it easy for you! And, once you set this macro up to work the way you want, it will save you TONS of time.

I hope this helps!

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