Сравнение диапазонов, вывод совпадение в разных книгах

[strannick]

Добрый день, уважаемые форумчане!
Сравнение диапазонов и поиск совпадений - тема, конечно, не новая. Вот тут и макрос практически готовый на форуме имеется:

Sub DelDups_TwoLists()
Dim a, b, i As Long, j As Long
Application.ScreenUpdating = False
With Sheets("Лист1")
a = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp)).Value
End With
With Sheets("Лист2")
b = .Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp)).Value
End With
For i = UBound(a) To 2 Step -1
For j = 2 To UBound(b)
If a(i, 1) = b(j, 1) Then Sheets("Лист1")... делаем чего надо
Next j, i
Application.ScreenUpdating = True
End Sub

Вопрос вот в чем. Такое сравнение надо встроить в существующую процедуру таким образом - сравнили поячеечно строку, в случае совпадения дописали в ячейку, следующую за последней в строке, через запятую названия совпавших столбцов или в самих совпавших ячейках выделить шрифт другим цветом, а потом этот же диапазон ячеек перенести в диапазон, с которым сравниваем. Таким образом, диапазон, с которым спавниваем будет все время пополняться.
Но главный вопрос - можно ли все это осуществлять, если диапазон, с которым сравниваем, находится в другой закрытой книге. Если да, то каким образом? Тут просто важен показатель быстродействия. Я тут приложил файл. На Листе1 - что сравниваем, на Листе2 - с чем сравниваем.
Заранее спасибо!

[strannick]

С поиском совпадений разобрался. Вот тут код, который находит совпадения между таблицами на листах 1 и 2 и подсвечивает шрифт синим цветом:

Sub Совпадения1()
Application.ScreenUpdating = False
 Dim i As Integer, j As Integer, k As Integer
 Dim sh As Worksheet, sh1 As Worksheet
 Dim iLastRow As Long, iLastRow1 As Long
    Set sh = Sheets("Лист1")
    Set sh1 = Sheets("Лист2")
    iLastRow = sh.Cells(Rows.Count, 1).End(xlUp).Row
    iLastRow1 = sh1.Cells(Rows.Count, 1).End(xlUp).Row 
For i = 2 To iLastRow
For j = 2 To iLastRow1
For k = 1 To 6
     If sh.Cells(i, k).Value = sh1.Cells(j, k).Value Then
     sh.Cells(i, k).Font.Color = -4165632
     ActiveSheet.Hyperlinks.Add Anchor:=sh.Cells(i, 7), Address:="", SubAddress:="Лист2!" & sh1.Cells(j, k)
     End If
    Next
    Next
    Next
 Application.ScreenUpdating = True
End Sub

Замыслил следующее - в столбец G выводить гиперссылку на совпавшую ячейку на листе 2. Вот эта строка:

ActiveSheet.Hyperlinks.Add Anchor:=sh.Cells(i, 7), Address:="", SubAddress:="Лист2!" & sh1.Cells(j, k)

Но ссылка не та получается. Что я не так прописал в SubAddress?
И еще, подправьте код, если такие таблицы в двух разных файлах.
Спасибо!

[strannick]

Разобрался и с разными книгами. Код сравнивает все ячейки с файлом база.xlsx, помечает синим шрифт совпавших ячеек, проверяет по имени и адресу, прописывает в столбец Н "не обработан..." если имя или адрес совпали, переносит данные в файл база. Но вот гиперссылка хоть и переносит на файл база.xlsx, но не на ячейку, а вообще на файл и выдает "неверная ссылка". Все таки с адресом что-то не так:

If sh.Cells(i, k).Value = sh1.Cells(j, k).Value Then
     sh.Cells(i, k).Font.Color = -4165632
     ActiveSheet.Hyperlinks.Add Anchor:=sh.Cells(i, 7), Address:="база.xlsx", SubAddress:="Заказы!" & sh1.Cells(j, k)
     End If

Поправьте меня.

[IgorGO]

может к имени файла полный путь к нему добавить?

[strannick]

Прописал:

ActiveSheet.Hyperlinks.Add Anchor:=sh.Cells(i, 7), Address:="D:\Заказ автомат\база.xlsx", SubAddress:="Заказы!" & sh1.Cells(j, k)

Эффект тот же - на файл перекидывает, но конкретную ячейку "sh1.Cells(j, k)" не указывает, пишет "неверная ссылка". Видать, все-таки в субадресе не так надо прописать эту переменную ячейку.

[IgorGO]

видать, надо пробовать хоть что-нибудь...
... Cells(j, k).address

[strannick]

Спасибо Игорь! Так работает.
Теперь прикрутил код сравнения к основной процедуре и понял, что поторопился с выводами. Работать-то работает, но тормозит жутко. Строка с 7-го по 22-й столбец с диапазоном G3:V128 поячеечно сравнивается 2 минуты. Как такую строку и такой диапазон, который пополняется вниз загнать в массивы и сравнить? Вот что-то типа этого:

Curr1 = sh5.Cells(3, 7).Resize(iLastRow1, 1).Value
Curr2 = sh.Cells(i, 7).Resize(, 22).Value
For y = 2 To iLastRow1
    For z = 7 To 22
     If Curr2(i, z) = Curr1(y, z) Then
     Curr2(i, z).Font.Color = -4165632
     ActiveSheet.Hyperlinks.Add Anchor:=Curr2(i, 27), Address:="D:\Заказ автомат\База заказов\база.xlsx", SubAddress:="Заказы!" & Curr1(y, z).Address
       End If
    Next
  Next