MS Excel и VBA: быстрое сравнение двух списков

 20 декабря 2015, воскресение Наиль  5204




Здравствуй! Представляю твоему вниманию несложный макрос, который быстро сравнит два списка в Microsoft Excel. Этот макрос очень актуален и по сегодняшний день. Во-первых, в старых версиях MS Office нет встроенного сравнения списков. Во-вторых, в новых версиях хоть и есть встроенная функция сравнения списков, но работает она очень-очень медленно с большими массивами данных! Поэтому взять на вооружение такой макрос нужно обязательно.

MS Excel и VBA: быстрое сравнение двух списков

Книгу необходимо разделить на три листа:

  • Список 1. Сюда помещается первый.
  • Список 2. Сюда помещается второй список.
  • Результат. Здесь отобразится результат сравнения. На нем всего лишь одна кнопка для удобства запуска макроса рядовым пользователем.

Важно! Поля с уникальными значениями должны находиться в столбце A и иметь одинаковый формат. Уникальными значениями могут быть порядковые номера, идентификаторы, ИНН, СНИЛС, регистрационные номера и другие.

MS Excel и VBA: быстрое сравнение двух списков

Кнопка, для быстрого запуска макроса:

MS Excel и VBA: быстрое сравнение двух списков

Далее нужно перейти в редактор Visual Basic for Application нажав комбинацию клавиш Alt - F11.

MS Excel и VBA: быстрое сравнение двух списков

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

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Sheets(3).Cells.Clear
Sheets(3).Cells(3, 1) = "ЕСТЬ ТОЛЬКО В ПЕРВОМ СПИСКЕ"
Sheets(3).Cells(3, 4) = "ЕСТЬ ТОЛЬКО ВО ВТОРОМ СПИСКЕ"
Sheets(3).Cells(3, 7) = "ЕСТЬ В ОБОИХ СПИСКАХ"
Y1 = 4
Y2 = 4
Y3 = 4
For Y = 1 To Sheets(1).UsedRange.Rows.Count
Set R = Sheets(2).Range("A:A").Find(Sheets(1).Cells(Y, 1))
If R Is Nothing Then
Y1 = Y1 + 1
Sheets(3).Cells(Y1, 1) = Sheets(1).Cells(Y, 1)
Else
Y3 = Y3 + 1
Sheets(3).Cells(Y3, 7) = Sheets(1).Cells(Y, 1)
End If
Next
For Y = 1 To Sheets(2).UsedRange.Rows.Count
Set R = Sheets(1).Range("A:A").Find(Sheets(2).Cells(Y, 1))
If R Is Nothing Then
Y2 = Y2 + 1
Sheets(3).Cells(Y2, 4) = Sheets(2).Cells(Y, 1)
End If
Next
MsgBox "Выполнено полностью", vbInformation
End
End Sub

Готово! Запускать макрос можно либо через кнопку из третьего листа, либо горячей клавишей F5. Процесс обработки занимает некоторое время. Здесь нужно подождать сообщения об успешном окончании процесса. В моем случае 5 тыс. элементов в каждом списке сравнивались за несколько секунд на среднем офисном компьютере.

Сообщение об окончании процесса сравнения:

MS Excel и VBA: быстрое сравнение двух списков

Окончательный результат представлен на рисунке ниже. Лист разделен на три части:

  • Элементы, которые есть только в первом списке, но нет во втором
  • Элементы которые есть только во втором, но нет в первом
  • Есть в обоих списках (и в первом и во втором)

MS Excel и VBA: быстрое сравнение двух списков

Надеюсь данный макрос поможет сэкономить тебе кучу времени и избавит от рутинного труда!