Добрый вечер. Подскажите, пожалуйста, что не так в макросе. Задача следующая на двух листах размещены списки ИНН. Необходимо их сравнить и цветом выделить дубликаты. Размеры списков на обеих листах будут меняться. Нашел на просторах интернет и адаптировал под себя следующий макрос
Код
Sub Сoincidence()
Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("Лист1")
Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Sheets("Лист2")
Dim Numbers1, Numbers2, i
Dim Found As Range
Numbers1 = ws1.Range("B2:B" & ws1.Range("B" & ws1.Rows.Count).End(xlUp).Row).Value
Numbers2 = ws2.Range("В2:В" & ws2.Range("B" & ws2.Rows.Count).End(xlUp).Row).Value
For i = LBound(Numbers2, 1) To UBound(Numbers2, 1)
Set Found = ws1.Range("B2:B").Find(Numbers2(i, 1))
If Not Found Is Nothing Then
Found.Interior.Color = vbYellow
End If
Set Found = Nothing
Next i
For i = LBound(Numbers1, 1) To UBound(Numbers1, 1)
Set Found = ws2.Range("В2:В").Find(Numbers1(i, 1))
If Not Found Is Nothing Then
Found.Interior.Color = vbYellow
End If
Set Found = Nothing
Next i
End Sub
Но при запуске вот здесь
Код
Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Sheets("Лист2")
выскакивает ошибка: Subscript out of range Что не так и почему для ws1 она не появляеться?
Во вложении файл с примером. Небольшое дополнение. На листе 1 будет большая таблица и список ИНН будет именно в столбце В и начинаться будет со второй строчки. На листе 2 список можно поместить в любое место
ThisWorkbook - книга с запускаемым макросом. Возможно, в ней нет листа Лист2 и вообще нужных данных. Можно попробовать все ThisWorkbook переделать на ActiveWorkbook или указать конкретно Workbooks("test.xlsx").
Sub Сoincidence()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim Numbers1 As Variant, Numbers2 As Variant, i As Long
Dim Found As Range
Set ws1 = ThisWorkbook.Sheets("Лист1")
Set ws2 = ThisWorkbook.Sheets("Лист2")
'снимаем выделения в столбцах В
ws1.Columns(2).Interior.Color = xlNone
ws2.Columns(2).Interior.Color = xlNone
Numbers1 = ws1.Range("B2:B" & ws1.Range("B" & ws1.Rows.Count).End(xlUp).Row).Value
Numbers2 = ws2.Range("B2:B" & ws2.Range("B" & ws2.Rows.Count).End(xlUp).Row).Value
For i = LBound(Numbers2, 1) To UBound(Numbers2, 1)
Set Found = ws1.Range("B:B").Find(Numbers2(i, 1))
If Not Found Is Nothing Then
Found.Interior.Color = vbYellow
End If
Set Found = Nothing
Next i
For i = LBound(Numbers1, 1) To UBound(Numbers1, 1)
Set Found = ws2.Range("B:B").Find(Numbers1(i, 1))
If Not Found Is Nothing Then
Found.Interior.Color = vbYellow
End If
Set Found = Nothing
Next i
MsgBox "Конец", vbInformation, ""
End Sub