Поиск ошибок, определить в какой из ячеек ошибка

[KaSS]

Здравствуйте, помогите пожалуйста, хотя бы с алгоритмом, как это сделать.
В общем, у меня есть 2 таблички 123 и 456. В них содержатся одинаковые данные, но могут быть перепутаны. 456 набирают руками, поэтому, могут быть опечатки(в любом из столбцов и в нескольких сразу). Необходимо их сравнить и подсветить ячейки в которых содержатся ошибки. Я сделала так, чтобы подсвечивалась вся строка. А придумать как подсветить ячейки в которых ошибки я придумать не могу(
Прикладываю файл с простым примером и как это выполняестя сейчас.Книга2.rar

[staniiislav]

попробуйте так:

Option Explicit

Sub sravnenie()
Dim a, i&, j&, n$, sr$, AddressK, rng As Range, rng2 As Range, sh As Worksheet
If MsgBox("Произвести сравнение?", vbYesNo, "ПОДТВЕРЖДЕНИЕ") = vbNo Then Exit Sub
Range("A1:G" & Cells(Rows.Count, 1).End(xlUp).Row).Interior.Color = xlNone
Set sh = Worksheets("123")
Set rng2 = sh.Range("A1:G" & sh.Cells(Rows.Count, 1).End(xlUp).Row)
a = sh.Range("A1:G" & sh.Cells(Rows.Count, 1).End(xlUp).Row).Value
With CreateObject("Scripting.Dictionary")
    For i = 2 To UBound(a)
         .Item(Join(Array(a(i, 1), a(i, 2), a(i, 3), a(i, 4), a(i, 5), a(i, 6), a(i, 7)), "|")) = Empty
    Next i

    a = Range("A1:G" & Cells(Rows.Count, 1).End(xlUp).Row).Value
    
    For i = 2 To UBound(a)
        n = a(i, 5) & "|" & a(i, 4) & "|" & a(i, 3) & "|" & a(i, 7) & "|" & a(i, 2) & "|" & a(i, 6) & "|" & a(i, 1)
        If Not .Exists(n) Then
            sr = sr & i & ", "
            Set rng = rng2.Find(Cells(i, 5), , xlValues, xlWhole)
                If Not rng Is Nothing Then
                    AddressK = rng.Address
                    Do
                        If sh.Cells(rng.Row, 7) = Cells(i, 1) Then Exit Do
                        Set rng = rng2.FindNext(rng)
                    Loop While AddressK <> rng.Address
                        If sh.Cells(rng.Row, 1) <> Cells(i, 5) Then Cells(i, 5).Interior.Color = vbRed
                        If sh.Cells(rng.Row, 2) <> Cells(i, 4) Then Cells(i, 4).Interior.Color = vbRed
                        If sh.Cells(rng.Row, 3) <> Cells(i, 3) Then Cells(i, 3).Interior.Color = vbRed
                        If sh.Cells(rng.Row, 4) <> Cells(i, 7) Then Cells(i, 7).Interior.Color = vbRed
                        If sh.Cells(rng.Row, 5) <> Cells(i, 2) Then Cells(i, 2).Interior.Color = vbRed
                        If sh.Cells(rng.Row, 6) <> Cells(i, 6) Then Cells(i, 6).Interior.Color = vbRed
                        If sh.Cells(rng.Row, 7) <> Cells(i, 1) Then Cells(i, 1).Interior.Color = vbRed
                    'Range("A" & i & ":" & "G" & i).Interior.Color = vbRed
                End If
        End If
    Next i
End With
If Not IsEmpty(sr) Then sr = Left(sr, Len(sr) - 2): MsgBox "Несоответсвие в строках: [" & sr & "]", vbExclamation, "Сравнение"
End Sub

При сравнении привязался к коду и сумме

[KaSS]

staniiislav, Спасибо =) буду разбираться с вашим кодом. Я пока только учусь=(

Одно но... Если ошибка в столбце Код, по которому производится поиск, то он его не подсвечивает=( А мне надо что бы посветил.

[staniiislav]

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

staniiislav, Спасибо =) буду разбираться с вашим кодом. Я пока только учусь=(

Одно но... Если ошибка в столбце Код, по которому производится поиск, то он его не подсвечивает=( А мне надо что бы посветил.

Просто в вашем примере нет уникального или хотя бы того значения в столбце которое не изменяется, тогда наверно не получится сделать то что вы хотите, по крайней мере я не представляю как это сделать... У вас же есть еще и повторяющиеся значения, как понять какое из них какое в правильном варианте?

только подсветить диапазон с ошибкой:

Sub sravnenie()
Dim a, i&, n$, sh As Worksheet
If MsgBox("Произвести сравнение?", vbYesNo, "ПОДТВЕРЖДЕНИЕ") = vbNo Then Exit Sub
Range("A1:G" & Cells(Rows.Count, 1).End(xlUp).Row).Interior.Color = xlNone
Set sh = Worksheets("123")
a = sh.Range("A1:G" & sh.Cells(Rows.Count, 1).End(xlUp).Row).Value
With CreateObject("Scripting.Dictionary")
    For i = 2 To UBound(a)
         .Item(Join(Array(a(i, 1), a(i, 2), a(i, 3), a(i, 4), a(i, 5), a(i, 6), a(i, 7)), "|")) = Empty
    Next i

    a = Range("A1:G" & Cells(Rows.Count, 1).End(xlUp).Row).Value
    
    For i = 2 To UBound(a)
        n = a(i, 5) & "|" & a(i, 4) & "|" & a(i, 3) & "|" & a(i, 7) & "|" & a(i, 2) & "|" & a(i, 6) & "|" & a(i, 1)
        If Not .Exists(n) Then Range("A" & i & ":" & "G" & i).Interior.Color = vbRed
    Next i
End With
End Sub

[KaSS]

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

Просто в вашем примере нет уникального или хотя бы того значения в столбце которое не изменяется, тогда наверно не получится сделать то что вы хотите, по крайней мере я не представляю как это сделать... У вас же есть еще и повторяющиеся значения, как понять какое из них какое в правильном варианте?

Да и я о том же, потому и не могла придумать, как это реализовать. Но я так подумала и решила что можно подсвечивать всю строку красным, а потом например желтым выделять ошибки, как Вы это делали. Тогда если просто красная строка то значит или её вообще нет в списке где проводится поиск или то что ошибка в поле Код. Думаю так будет наглядно.=)