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

我会说两个空单元格匹配，而不是运行此宏时，所有空单元格都将具有红色字体。因此，如果条件

，请添加cell.Value <> ""

Answer 2

您可以使用工作表更改事件：

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

将其放在数据所在工作表的代码表中。

在运行宏之前遇到VBA重复条件

2 个答案: