Сравнить две таблицы в excel vba

Обратите внимание , что в вашем исходном файле форматы некоторых чисел в листах не совпадают, хотя сами числа равны друг другу.

Например в ячейке B7 и в первом и во втором листе стоит цифра 11,6633333541895
но функция =ВПР(Лист1!B7;Лист2!B:B;1;0) показывает Н/Д (см в ячейке Лист1!B15)

Поэтому, чтобы сравнивать цифры в этих таблицах их приходится сначала преобразовывать в строки и потом сравнивать (строка 10 в коде ниже).

Запускайте макрос и в диалоговом окне укажите диапазон ячеек из той таблицы с которой нужно сравнить таблицу в листе 1 в ячейках с одинаковым адресом.

Private Sub Find_MisMatches()
Dim CompareRange As Range, x As Range, y As Range, InitialSheet As Worksheet
Dim i As Long, j As Long ‘ переменные для записи номеров строк и столбов в ячейках из дипазона Comparerange

Set InitialSheet = Worksheets(«Лист1») ‘ устанавливаем диапазон в котором надо подсветить совпадающие ячейки из листа 1 при сравнении с Comparerange. В данном случае выбирается диапазон со всеми когда-либо заполненными ячейками в Листе1
Set CompareRange = Application.InputBox(«Укажите диапазон ячеек для сравнения», «Запрос данных», «B2:S10», Type:=8) ‘диапазон в листе 2 с которым сравнивают. В данном случае это все когда-либо заполненные ячейки в листе2

Application.ScreenUpdating = False
InitialSheet.UsedRange.Interior.ColorIndex = xlNone ‘ очищаем заливку в диапазоне где будем заливать совпадающие ячейки

On Error Resume Next

‘Вар3. Подсвечивает ячейки в сравниваемом диапазоне , но только в тех ячейках ,
‘у которых тот же самый адрес , что и выбранном диаппазоне CompareRange

‘Если выбрано менее двух ячеек
If CompareRange.Count = 1 Then
MsgBox «Для отбора уникальных значений требуется указать более одной ячейки», vbInformation
Exit Sub
End If

‘если указаны только пустые ячейки вне рабочего диапазона
If CompareRange Is Nothing Then
MsgBox «Недостаточно данных для выбора значений», vbInformation
Exit Sub
End If

‘Запускаем цикл по каждой ячейке из Comparerange
For Each y In CompareRange

i = y.Row ‘ записываем номер строки ячейки из Comparerange
j = y.Column ‘записываем номер столбца ячейки из Comparerange

10 If CStr(InitialSheet.Cells(i, j).Value) = CStr(CompareRange.Parent.Cells(i, j).Value) Then ‘ здесь преобразовываем данные в ячейках в текстовый формат и сравниваем
InitialSheet.Cells(i, j).Interior.Color = vbGreen ‘если данные в ячейке из сравниваемого диапазона на листе 1 совпадают с данными в ячейке из диапазона CompareRange с тем же номером строки и с тем же номер столбца, то подсвечиваем зеленым
End If

Next y
MsgBox «Данные проверены»
End Sub

Обратите внимание , что в вашем исходном файле форматы некоторых чисел в листах не совпадают, хотя сами числа равны друг другу.

Например в ячейке B7 и в первом и во втором листе стоит цифра 11,6633333541895
но функция =ВПР(Лист1!B7;Лист2!B:B;1;0) показывает Н/Д (см в ячейке Лист1!B15)

Поэтому, чтобы сравнивать цифры в этих таблицах их приходится сначала преобразовывать в строки и потом сравнивать (строка 10 в коде ниже).

Запускайте макрос и в диалоговом окне укажите диапазон ячеек из той таблицы с которой нужно сравнить таблицу в листе 1 в ячейках с одинаковым адресом.

Private Sub Find_MisMatches()
Dim CompareRange As Range, x As Range, y As Range, InitialSheet As Worksheet
Dim i As Long, j As Long ‘ переменные для записи номеров строк и столбов в ячейках из дипазона Comparerange

Set InitialSheet = Worksheets(«Лист1») ‘ устанавливаем диапазон в котором надо подсветить совпадающие ячейки из листа 1 при сравнении с Comparerange. В данном случае выбирается диапазон со всеми когда-либо заполненными ячейками в Листе1
Set CompareRange = Application.InputBox(«Укажите диапазон ячеек для сравнения», «Запрос данных», «B2:S10», Type:=8) ‘диапазон в листе 2 с которым сравнивают. В данном случае это все когда-либо заполненные ячейки в листе2

Application.ScreenUpdating = False
InitialSheet.UsedRange.Interior.ColorIndex = xlNone ‘ очищаем заливку в диапазоне где будем заливать совпадающие ячейки

On Error Resume Next

‘Вар3. Подсвечивает ячейки в сравниваемом диапазоне , но только в тех ячейках ,
‘у которых тот же самый адрес , что и выбранном диаппазоне CompareRange

‘Если выбрано менее двух ячеек
If CompareRange.Count = 1 Then
MsgBox «Для отбора уникальных значений требуется указать более одной ячейки», vbInformation
Exit Sub
End If

‘если указаны только пустые ячейки вне рабочего диапазона
If CompareRange Is Nothing Then
MsgBox «Недостаточно данных для выбора значений», vbInformation
Exit Sub
End If

‘Запускаем цикл по каждой ячейке из Comparerange
For Each y In CompareRange

i = y.Row ‘ записываем номер строки ячейки из Comparerange
j = y.Column ‘записываем номер столбца ячейки из Comparerange

10 If CStr(InitialSheet.Cells(i, j).Value) = CStr(CompareRange.Parent.Cells(i, j).Value) Then ‘ здесь преобразовываем данные в ячейках в текстовый формат и сравниваем
InitialSheet.Cells(i, j).Interior.Color = vbGreen ‘если данные в ячейке из сравниваемого диапазона на листе 1 совпадают с данными в ячейке из диапазона CompareRange с тем же номером строки и с тем же номер столбца, то подсвечиваем зеленым
End If

Next y
MsgBox «Данные проверены»
End Sub

Сообщение Обратите внимание , что в вашем исходном файле форматы некоторых чисел в листах не совпадают, хотя сами числа равны друг другу.

Например в ячейке B7 и в первом и во втором листе стоит цифра 11,6633333541895
но функция =ВПР(Лист1!B7;Лист2!B:B;1;0) показывает Н/Д (см в ячейке Лист1!B15)

Поэтому, чтобы сравнивать цифры в этих таблицах их приходится сначала преобразовывать в строки и потом сравнивать (строка 10 в коде ниже).

Запускайте макрос и в диалоговом окне укажите диапазон ячеек из той таблицы с которой нужно сравнить таблицу в листе 1 в ячейках с одинаковым адресом.

Private Sub Find_MisMatches()
Dim CompareRange As Range, x As Range, y As Range, InitialSheet As Worksheet
Dim i As Long, j As Long ‘ переменные для записи номеров строк и столбов в ячейках из дипазона Comparerange

Set InitialSheet = Worksheets(«Лист1») ‘ устанавливаем диапазон в котором надо подсветить совпадающие ячейки из листа 1 при сравнении с Comparerange. В данном случае выбирается диапазон со всеми когда-либо заполненными ячейками в Листе1
Set CompareRange = Application.InputBox(«Укажите диапазон ячеек для сравнения», «Запрос данных», «B2:S10», Type:=8) ‘диапазон в листе 2 с которым сравнивают. В данном случае это все когда-либо заполненные ячейки в листе2

Application.ScreenUpdating = False
InitialSheet.UsedRange.Interior.ColorIndex = xlNone ‘ очищаем заливку в диапазоне где будем заливать совпадающие ячейки

On Error Resume Next

‘Вар3. Подсвечивает ячейки в сравниваемом диапазоне , но только в тех ячейках ,
‘у которых тот же самый адрес , что и выбранном диаппазоне CompareRange

‘Если выбрано менее двух ячеек
If CompareRange.Count = 1 Then
MsgBox «Для отбора уникальных значений требуется указать более одной ячейки», vbInformation
Exit Sub
End If

‘если указаны только пустые ячейки вне рабочего диапазона
If CompareRange Is Nothing Then
MsgBox «Недостаточно данных для выбора значений», vbInformation
Exit Sub
End If

‘Запускаем цикл по каждой ячейке из Comparerange
For Each y In CompareRange

i = y.Row ‘ записываем номер строки ячейки из Comparerange
j = y.Column ‘записываем номер столбца ячейки из Comparerange

10 If CStr(InitialSheet.Cells(i, j).Value) = CStr(CompareRange.Parent.Cells(i, j).Value) Then ‘ здесь преобразовываем данные в ячейках в текстовый формат и сравниваем
InitialSheet.Cells(i, j).Interior.Color = vbGreen ‘если данные в ячейке из сравниваемого диапазона на листе 1 совпадают с данными в ячейке из диапазона CompareRange с тем же номером строки и с тем же номер столбца, то подсвечиваем зеленым
End If

Next y
MsgBox «Данные проверены»
End Sub

Источник

Adblock
detector