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

[doober]

Пишите в личку.договоримся

[onenures]

Добрый день. Макрос с первой страницы ни с того, ни с сего начал ругаться на строку

Workbooks("Книга1.xls").Sheets(1).A ctivate
With Workbooks("Книга2.xls").Sheets(1)

Excel 2003. Файлы открыты. Соответственно Книгу1 он находит, а вторую нет. Что может быть не пойму...

[Osman91]

Ребят а не поможете с макросом. тем же что и на 1й странице, только требуется чтобы он после поиска одинаковых значений строк (даже если разные строки) в двух столбцах выписал в 3ю книгу несовпавшией значения. ну или те что остаются незакрашенными

Sub Main()

Dim i As Long, x As New Collection
Application.ScreenUpdating = False
Workbooks("Êíèãà1.xls").Sheets(1).A ctivate
On Error Resume Next
For i = 1 To Cells(Rows.Count, "C").End(xlUp).Row
x.Add Cells(i, "C"), CStr(Cells(i, "C"))
Next
On Error GoTo 0

With Workbooks("Êíèãà2.xls").Sheets(1)
Columns("C").Interior.ColorIndex = xlNone
For i = 1 To .Cells(Rows.Count, "C").End(xlUp).Row
On Error Resume Next
x.Add .Cells(i, "C"), CStr(.Cells(i, "C"))
If Err <> 0 Then .Cells(i, "C").Interior.ColorIndex = 6
On Error GoTo 0
Next
End With
Set x = Nothing

End Sub

[ventil34]

Здравствуйте, всем
Уважаемый SAS888, спасибо огромное Вам за труды.
С успехом применяю Ваши коды.
Будете в Киеве, с меня пиво

С уважением, Виталий

[dinzhevatov]

Доброго времени суток! Столкнулся с похожей проблемой, опыта с VBA мало поэтому решил обратится за помощью, задача примерно похожая, нужно сравнить 3 столбца в 2 файлах (Книга1 столбец А(лиц.счет) Стобец Р(типсчет) Столбец Q(номерсчет) Книга2 столбец А(лиц.счет) Стобец Е(номерсчет) Столбец F(типсчет)) нужно сравнить эти 3 столбца в обоих файлах и если хоть по одному не будет совпадение подсветить его. Сам пытался подправить макрос с первой страницы, но пока без результативно.

[rosomaha666]

Сообщение от SAS888

!!!!!!!!
А сейчас Вы грамотно написали? Наверное, имелось ввиду, что нужно примерно так:

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

Скажите, глубокоуважаемый SAS888, а возможно ли в этом макросе увеличить количество книг, в которых будет производится сравнение одинаковых ячеек (Книга3.xls, Книга4.xls, Книга5.xls...Книга18.xls). Если это возможно, напишите, пожалуйста код макроса. Спасибо!

[Nick31]

в данном файле много значений и он виснит при поиске, возможно ли как-то это поправить?

[Hugo121]

Полторы секунды.
Но если будут дубли - то первые во втором листе не покрасит. Как в прочем и Ваш код - но он не покрасит все следующие...
Можно это пофиксить, как впрочем и ещё чуть ускорить - но лениво... да и может по задаче не нужно...

Sub Main()
Dim tm!: tm = Timer
    Dim i As Long, t as long
    Dim a(): Application.ScreenUpdating = False
    Sheets(1).Rows("3:" & Rows.Count).Interior.ColorIndex = xlNone
    With Sheets(2)
        .Rows("3:" & Rows.Count).Interior.ColorIndex = xlNone
        a = .[c1].CurrentRegion.Value
        With CreateObject("scripting.dictionary")
            .comparemode = 1
            For i = 2 To UBound(a): .Item(a(i, 1)) = i: Next
            a = Sheets(1).[c1].CurrentRegion.Value
            For i = 4 To UBound(a)
                If .exists(a(i, 1)) Then
                    t = .Item(a(i, 1))
                    With Sheets(1)
                        Range(.Cells(i, 1), .Cells(i, 8)).Interior.ColorIndex = 6
                    End With
                    With Sheets(2)
                        Range(.Cells(t, 1), .Cells(t, 8)).Interior.ColorIndex = 6
                    End With
                End If
            Next
        End With
    End With
    Debug.Print Timer - tm
End Sub

Быстрее было бы создать новую книгу, куда выгрузить найденные совпадающие номера.

[Urfinjust]

на работе на хрюшке все работает без проблем а на семерке отказывается находить какую-либо вторую запущенную книгу. Постоянно выдает строчку

With Workbooks("22.xls").Sheets(1)

Обе книги открыты

[IgorGO]

другая книга открыта в другом экземпляре ексель, ее нет списке Workbooks текущего экземпляра.