VBA - Сравните два листа и выделите изменения

Question

Я пытаюсь сравнить два листа. Структура листа абсолютно одинакова -> Ячейка AD4 в Sheet1 должна быть такой же, как AD4 в Sheet2, если нет, то выделите ячейку AD4. Это должно быть сделано, поскольку данные существуют.

Приведенный ниже код не работает, но не выводит сообщение об ошибке.

Sub CompareAndHighlightDifferences()
Dim w1 As Worksheet, w2 As Worksheet
Dim c As Range, a As Range
Set w1 = Sheets("2019 Project Detail")
Set w2 = Sheets("2019 Project Detail SOURCE")
With w1
  For Each c In .Range("AD4", .Range("AD" & Rows.Count).End(xlUp))
    Set a = w2.Columns(30).Find(c.Value, LookAt:=xlWhole)
    If Not a Is Nothing Then
      If .Cells(c.Row, c.Column).Value <> w2.Cells(a.Row, a.Column) Then
         .Cells(c.Row, c.Column).Font.Color = vbRed
      End If
    End If
  Next c
End With
End Sub

Могу ли я попросить вас дать какие-нибудь советы, пожалуйста?

Большое спасибо!

--------------------- EDIT ----------------------

Sub CompareAndHighlightDifferences()
Dim w1 As Worksheet, w2 As Worksheet
Dim c As Range
Set w1 = Sheets("2019 Project Detail")
Set w2 = Sheets("2019 Project Detail SOURCE")

  For Each c In w1.Range("AD4", w1.Range("AD" & Rows.Count).End(xlUp))
    If w1.Cells(c.Row, c.Column).Value = w2.Cells(c.Row, c.Column).Value Then
       w1.Cells(c.Row, c.Column).Interior.Color = vbRed
    End If
  Next c

End Sub

Answer 1

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

Вы можете удалить это и следующее, если условие:

Set a = w2.Columns(30).Find(c.Value, LookAt:=xlWhole)

И использовать тот же адрес при сравнении значений:

If .Cells (c.Row, c.Column) .Value <> w2.Cells ( c .Row, c .Column) .Value Тогда

/ e: Кроме того, вы можете использовать interior вместо font цвета, потому что если ячейка пуста, будет разница, которую вы не сможете увидеть

Answer 2

Я бы использовал что-то вроде этого:

Sub CompareAndHighlightDifferences()

Dim w1 As Worksheet, w2 As Worksheet

Set w1 = Sheets("2019 Project Detail")
Set w2 = Sheets("2019 Project Detail SOURCE")

With w1
    For Each cel In .UsedRange
        If cel.Value <> w2.Cells(cel.Row, cel.Column).Value Then cel.Font.Color = vbRed
    Next cel
End With

End Sub

Редактировать: Если ваш лист защищен, вы должны добавить w1.Unprotect в начале и w1.Protect в конце.