Необходима помощь в написании макроса: есть таблица "Список ВП" - в оригинале в ней около 150 записей, все уникальные, т.е. это эталон. Так же есть таблица на листе "Выгрузка" - содержит большое количество записей (>6000). В этой таблице нужно найти значения, которых нет в эталонной таблице и выделить такие записи цветом. Важно, чтобы в сравнении учитывались все 3 столбца, а не только ID.
Буду очень благодарна за помощь!
Всем доброго времени суток!
Необходима помощь в написании макроса: есть таблица "Список ВП" - в оригинале в ней около 150 записей, все уникальные, т.е. это эталон. Так же есть таблица на листе "Выгрузка" - содержит большое количество записей (>6000). В этой таблице нужно найти значения, которых нет в эталонной таблице и выделить такие записи цветом. Важно, чтобы в сравнении учитывались все 3 столбца, а не только ID.
Sub Мяу() Dim ar, oDic As Object, i& Set oDic = CreateObject("Scripting.Dictionary") With Sheets("Список ВП") ar = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 3).Value End With For i = 1 To UBound(ar) oDic.Item(ar(i, 1) & "|" & ar(i, 2) & "|" & ar(i, 3)) = oDic.Count Next Application.ScreenUpdating = False With Sheets("Выгрузка") ar = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 3).Value For i = 1 To UBound(ar) If Not oDic.exists(ar(i, 1) & "|" & ar(i, 2) & "|" & ar(i, 3)) Then .Cells(i, 1).Resize(, 3).Interior.Color = vbRed End If Next End With Application.ScreenUpdating = True End Sub
[/vba]
[p.s.]Лена, возможно ты будешь удивлена, но в твоем файле мой мелкоскоп УФ не нашел.[/p.s.]
[vba]
Код
Sub Мяу() Dim ar, oDic As Object, i& Set oDic = CreateObject("Scripting.Dictionary") With Sheets("Список ВП") ar = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 3).Value End With For i = 1 To UBound(ar) oDic.Item(ar(i, 1) & "|" & ar(i, 2) & "|" & ar(i, 3)) = oDic.Count Next Application.ScreenUpdating = False With Sheets("Выгрузка") ar = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 3).Value For i = 1 To UBound(ar) If Not oDic.exists(ar(i, 1) & "|" & ar(i, 2) & "|" & ar(i, 3)) Then .Cells(i, 1).Resize(, 3).Interior.Color = vbRed End If Next End With Application.ScreenUpdating = True End Sub
[/vba]
[p.s.]Лена, возможно ты будешь удивлена, но в твоем файле мой мелкоскоп УФ не нашел.[/p.s.]RAN
Быть или не быть, вот в чем загвоздка!
Сообщение отредактировал RAN - Среда, 02.03.2022, 13:57