Сравнение двух столбцов в разных книгах

[LAnLorD]

Подскажите, если не затруднит - раньше с VBA в экселе не сталкивался
но неожиданно понадобилась - перечитал все что мог, но так и не понял как сделать :-(

Задача: Есть два файла экселя - нужно сравнить два столбца расположенных в разных книгах и выделить совпадающие значения цветом


--------- примечание модератора - вдруг кому пригодится --------------

Надстройка LOOKUP предназначена для сравнения и подстановки значений в таблицах Excel.

Если вам надо сравнить 2 таблицы (по одному столбцу, или по нескольким),
и для совпадающих строк скопировать значения выбранных столбцов из одной таблицы в другую,
надстройка «Lookup» поможет сделать это нажатием одной кнопки.

В настройках программы можно задать:

• где искать сравниваемые файлы (использовать уже открытый файл, загружать файл по заданному пути, или же выводить диалоговое окно выбора файла)
• с каких листов брать данные (варианты: активный лист, лист с заданным номером или названием)
• какие столбцы сравнивать (можно задать несколько столбцов)
• значения каких столбцов надо копировать в найденные строки (также можно указать несколько столбцов)

Скачать надстройку для сравнения таблиц Excel и копирования данных из одинаковых строк

[SAS888]

Пусть нужно сравнить столбцы "A" в файлах "Книга1.xls" и "Книга2.xls".
Следующий макрос подсветит в книге 2 ячейки, значения которых либо имеются в столбце "A" книги 1, либо повторяются в столбце "A" книги 2. Обе книги должны быть открыты

Sub Main()

    Dim i As Long, x As New Collection
    Application.ScreenUpdating = False
    Workbooks("Книга1.xls").Sheets(1).Activate
    On Error Resume Next
    For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
        x.Add Cells(i, "A"), CStr(Cells(i, "A"))
    Next
    On Error GoTo 0
    
    With Workbooks("Книга2.xls").Sheets(1)
        Columns("A").Interior.ColorIndex = xlNone
        For i = 1 To .Cells(Rows.Count, "A").End(xlUp).Row
            On Error Resume Next
            x.Add .Cells(i, "A"), CStr(.Cells(i, "A"))
            If Err <> 0 Then .Cells(i, "A").Interior.ColorIndex = 6
            On Error GoTo 0
        Next
    End With
    Set x = Nothing
    
End Sub

[LAnLorD]

Огромное спасибо за ответ!
Общее направление стало понятнее - теперь пойду дальше, нужно чтобы не выделялись повторяющиеся во второй книге значения - т.е. были выделены только те которые согласуются с первой книгой.
Так с цифровым столбцом данных - в нем есть повторяющиеся строки - но они не совпадают с первой книгой (но подсвечиваются). Также необходимо выделить и значения строк в первой книге...

[SAS888]

Ну, тогда можно и так:

Sub Main()

    Dim i As Long, x As Range, Fst As String
    Application.ScreenUpdating = False
    Workbooks("Книга1.xls").Sheets(1).Activate
    With Workbooks("Книга2.xls").Sheets(1)
        Columns("A").Interior.ColorIndex = xlNone
        .Columns("A").Interior.ColorIndex = xlNone
        For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
            Set x = .Columns("A").Find(what:=Cells(i, "A"), LookAt:=xlWhole)
            If Not x Is Nothing Then
                Cells(i, "A").Interior.ColorIndex = 6
                Fst = x.Address
                Do
                    .Cells(x.Row, "A").Interior.ColorIndex = 6
                    Set x = .Columns("A").FindNext(x)
                Loop While Fst <> x.Address
            End If
        Next
    End With
                    
End Sub

[LAnLorD]

Еще раз спасибо - но где-то опять заковырка
Все еще во второй книге выделяет повторяющиеся только в ней ячейки

[SAS888]

Вариант, предлагаемый в посте № 4 работает следующим образом:
Перебираются все строки столбца "A" в книге "Книга1.xls". Для каждого значения осуществляется поиск в столбце "A" книги "Книга2.xls". В случае обнаружения полного совпадения значений, подсвечивается искомая ячейка (в книге 1) и найденная (в книге 2). Затем поиск продолжается (надо?) если находится еще такое же значение, то оно тоже подсвечивается.
Таким образом, если в книге 2 есть повторяющиеся значения, но их нет в книге 1, то они подсвечены не будут. А если есть повторяющиеся значения в книге 2, которые совпадают с каким-либо значением в книге 1, то они будут подсвечены все.
А как нужно?

[LAnLorD]

Может я неправильно выразил свои мысли *pardon*
Данные располагаются в двух столбцах, расположенных в разных книгах.
Сопоставляются (сравниваются) строки - по принципу:
А1=А1 - если да то выделяются, если равны то не выделяются
А2=А2
...... и так до окончания столбца.
То есть если А1=А5 (в разных книгах) то это не имеет значения.
Эээх надо учиться писать грамотный вопрос :-)
Искренне благодарю за участие!

[SAS888]

Эээх надо учиться писать грамтный вопрос

!!!!!!!!
А сейчас Вы грамотно написали?

А1=А1 - если да то выделяются, если равны то не выделяются

Наверное, имелось ввиду, что нужно примерно так:

Sub Main()

    Dim i As Long
    Application.ScreenUpdating = False
    Workbooks("Книга1.xls").Sheets(1).Activate
    With Workbooks("Книга2.xls").Sheets(1)
        For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
            If Cells(i, "A") <> "" Then
                If Cells(i, "A") = .Cells(i, "A") Then
                    Cells(i, "A").Interior.ColorIndex = 6
                    .Cells(i, "A").Interior.ColorIndex = 6
                End If
            End If
        Next
    End With
                    
End Sub

[LAnLorD]

И правда - написал еще хуже чем в первый раз - но вы меня поняли абсолютно правильно. Все именно так и нужно - век не забуду *кланяется*

[N.S.]

пользуюсь скриптом из этой темы для сравнения двух файлов уже давно. низкий поклон тому, кто написал скрипт и поделился им с теми, у кого "руки не стоят"

а можно ли написать (переписать) скрипт таким образом, чтобы он не подсвечивал желтым схожие номера, а проставлял, например 1, в пустой колонке рядом?

буду премного благодарна, если кто-то мне поможет.