VBA Duplicate Condition Met Before Running Macro

Question

Я пытаюсь управлять дубликатами на листе Excel, если шрифт дубликатов ячеек становится красным. Я решил использовать макрос для проверки дубликатов, код ниже. Он работает, но у меня есть одна небольшая проблема:

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

Sub Duplicate() 
Dim rngData As Range 
Dim cell As Range 
Dim cell2 As Range 

Set rngData = Range("P3:P19, P56:P58, P39:P42, P21:P25, P27:P37, P39:P42, P39:P42, P44:P54, M25:M76, B69:B77, B66:E67, B51:B64, H44:H47, D44:D47, H42, H33:H40, D33:D42, H31, D28:D31, H28:H29, D5:D8" & Cells(Rows.Count, "B").End(xlUp).Row) 

rngData.Font.Color = vbBlack 

For Each cell In rngData 
    If cell.Font.Color = vbBlack Then 
     For Each cell2 In rngData 
      If cell = cell2 And cell.Address <> cell2.Address Then 
       cell.Font.Color = vbRed 
       cell2.Font.Color = vbRed 
      End If 
     Next 
    End If 
Next 


Set rngData = Nothing 

Application.ScreenUpdating = True 
End Sub 

Answer 1

Вы можете использовать рабочий лист Изменить событие:

Private Sub Worksheet_Change(ByVal Target As Range) 
Dim rngData As Range 
Application.EnableEvents = False 
On Error GoTo getout 
Set rngData = Range("P3:P19, P56:P58, P39:P42, P21:P25, P27:P37, P39:P42, P39:P42, P44:P54, M25:M76, B69:B77, B66:E67, B51:B64, H44:H47, D44:D47, H42, H33:H40, D33:D42, H31, D28:D31, H28:H29, D5:D8" & Cells(Rows.Count, "B").End(xlUp).Row) 

If Not Intersect(Target, rngData) Is Nothing Then 
    Duplicate 
End If 
Application.EnableEvents = True 
Exit Sub 

getout: 
Application.EnableEvents = True 
End Sub 

Положите это в коде листа на лист, на котором расположены данные.

Answer 2

Я бы сказал, что две пустые ячейки соответствуют, чем при запуске этого макроса, все пустые ячейки будут иметь красный цвет шрифта. Так что добавьте cell.Value <> "" к вам Если условие