Как сравнить столбцы с разными количествами строк в EXCEL 2007 ?

[lutdan]

Здравствуйте. Совсем запутался, как сделать.
"ВСЕ" - хранятся верные и неверные заказы
"Верные" - у этих клиентов все хорошо с заказом
"Не верные" - у этих клиентов не хорошо с заказом (например, не выполнен)
Необходимо: Сравнить "ДАТУ ЗАКАЗА" с "№" в колонке ВСЕ и "ДАТУ ЗАКАЗА" с "№" в колонке ВЕРНЫЕ. А в колонку НЕ ВЕРНЫЕ вывести те заказы которые не совпадают.
ЛИБО в колонке "ВСЕ" выделить красным несовпадения.

НАПРИМЕР. В колонке "ВСЕ" Дата заказа: 30.01.2013 и № 214134 отсутствует в "ВЕРНЫЕ". Значит мы их красим красным (следовательно они не верные т.е. не ВЫПОЛНЕНЫ!)
Вот необходимо их найти.

P.s. Можно было сделать вычитание ,то есть например если 214054 - 214054, то в колонку С пишется 0. А когда попадает несовпадение, то в колонке С появится результат вычитания. Ну и копировать - вставить. Но Хотелось бы автоматизировать этот процесс.
Заранее спасибо!

[staniiislav]

Только вчера рассматривали такой пример:

Option Explicit
Private Declare Function GetTickCount Lib "kernel32" () As Long

Sub sravnenie()
Dim a, b, i&, u, t, isect As Range
If MsgBox("Произвести сравнение?", 32 & vbYesNo, "ПОДТВЕРЖДЕНИЕ") = vbNo Then Exit Sub
t = GetTickCount
Application.ScreenUpdating = False
Range("A3:C" & Cells(Rows.Count, 1).End(xlUp).Row).Interior.ColorIndex = xlNone
    a = Range("E1:G" & Cells(Rows.Count, 5).End(xlUp).Row).Value
With CreateObject("Scripting.Dictionary")
    For i = 3 To UBound(a)
        '.Item(a(i, 1)) = .Item(a(i, 1) & "|" & a(i, 2) & "|" & a(i, 3) & "|" & a(i, 4) & "|" & a(i, 5) & "|" & a(i, 6))
         .Item(Join(Array(a(i, 1), a(i, 2), a(i, 3)), "|")) = Empty
    Next i

    a = Range("A1:C" & Cells(Rows.Count, 1).End(xlUp).Row).Value
    
    ReDim b(1 To UBound(a), 1 To 1)
    For i = 3 To UBound(a)
    u = a(i, 1) & "|" & a(i, 2) & "|" & a(i, 3)
        If Not .Exists(u) Then b(i, 1) = 1
    Next i
End With
Range("D1").Resize(UBound(b), 1).Value = b

On Error GoTo MyError
Set isect = Intersect(Range("A1:D" & UBound(b)), Range("D1:D" & UBound(b)).SpecialCells(xlCellTypeConstants).EntireRow)
If Not isect Is Nothing Then isect.Interior.ColorIndex = 37
    Range("D3:D" & UBound(b)).Interior.ColorIndex = xlNone
    Range("D3:D" & UBound(b)).ClearContents
    Exit Sub
    Application.ScreenUpdating = True
    Debug.Print (GetTickCount - t) / 1000
MyError:
    MsgBox "Совпадения не найдено.", vbInformation, "ГОТОВО"
    Application.ScreenUpdating = True
    Debug.Print (GetTickCount - t) / 1000
End Sub

Пробуйте

[IgorGO]

см. вложение

[Hugo121]

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

[staniiislav]

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

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

Так?:

Sub sravnenie2()
Dim a, b, i&, n&, t
If MsgBox("Произвести сравнение?", 32 & vbYesNo, "ПОДТВЕРЖДЕНИЕ") = vbNo Then Exit Sub
t = GetTickCount
    Range("I3:K" & Cells(Rows.Count, 9).End(xlUp).Row).ClearContents
    a = Range("E3:G" & Cells(Rows.Count, 5).End(xlUp).Row).Value
With CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(a)
         .Item(Join(Array(a(i, 1), a(i, 2)), "|")) = Empty
    Next i

    a = Range("A3:C" & Cells(Rows.Count, 1).End(xlUp).Row).Value
    
    ReDim b(1 To UBound(a), 1 To 3)
    For i = 1 To UBound(a)
        If Not .Exists(a(i, 1) & "|" & a(i, 2)) Then
            n = n + 1
            b(n, 1) = a(i, 1)
            b(n, 2) = a(i, 2)
            b(n, 3) = a(i, 3)
        End If
    Next i
End With

Range("I3").Resize(n, 3).Value = b
If n = 0 Then MsgBox "Совпадения не найдено.", vbInformation, "ГОТОВО"
Debug.Print (GetTickCount - t) / 1000
End Sub

[Hugo121]

Алгоритм такой (ячейки не вычитывал). Есть одно замечание - если n=0, то будет ошибка при выгрузке массива.
Т.е. сперва проверяем n, затем или выгрузка, или Msgbox.

[staniiislav]

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

Алгоритм такой (ячейки не вычитывал). Есть одно замечание - если n=0, то будет ошибка при выгрузке массива.
Т.е. сперва проверяем n, затем или выгрузка, или Msgbox.

Ошибки не вылазило, но правильнее сделать как вы говорили:

Sub sravnenie2()
Dim a, b, i&, n&, t
If MsgBox("Произвести сравнение?", 32 & vbYesNo, "ПОДТВЕРЖДЕНИЕ") = vbNo Then Exit Sub
t = GetTickCount
    Range("I3:K" & Cells(Rows.Count, 9).End(xlUp).Row).ClearContents
    a = Range("E3:G" & Cells(Rows.Count, 5).End(xlUp).Row).Value
With CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(a)
         .Item(Join(Array(a(i, 1), a(i, 2)), "|")) = Empty
    Next i

    a = Range("A3:C" & Cells(Rows.Count, 1).End(xlUp).Row).Value
    
    ReDim b(1 To UBound(a), 1 To 3)
    For i = 1 To UBound(a)
        If Not .Exists(a(i, 1) & "|" & a(i, 2)) Then
            n = n + 1
            b(n, 1) = a(i, 1)
            b(n, 2) = a(i, 2)
            b(n, 3) = a(i, 3)
        End If
    Next i
End With

If n = 0 Then
    MsgBox "Совпадения не найдено.", vbInformation, "ГОТОВО"
Else
    Range("I3").Resize(n, 3).Value = b
End If
Debug.Print (GetTickCount - t) / 1000
End Sub

[lutdan]

Спасибо Всем!!!

Макрос staniiislav'a работает. Я и не ожидал такого результата .. гениально!

Последний вопрос: staniiislav так использовать лучше последний Ваш код (Сообщение #7)?

[staniiislav]

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

Спасибо Всем!!!

Макрос staniiislav'a работает. Я и не ожидал такого результата .. гениально!

Последний вопрос: staniiislav так использовать лучше последний Ваш код (Сообщение #7)?

Держите пример
Запуск макроса по нажатию на кнопку (Сравнение2)

А можно вопрос. Чем Вам пример IgorGO не понравился? Он же вообще без макросов сделал?

Добавлено позже:

Имейте ввиду, что если вы будете добавлять или удалять столбцы в файле, в макросе нужно будет так же менять ссылки на другие столбцы!

[lutdan]

staniiislav Да оба способа хороши.
Всем спасибо! Тему можно закрыть