Private Sub Worksheet_Change(ByVal Target As Range) Dim KeyCells As Range Set KeyCells = Range("A:A") '要监视的列范围 If Not Application.Intersect(KeyCells, Target) Is Nothing Then '如果目标单元格位于指定列中，请执行以下操作 If WorksheetFunction.CountIf(Range("A:A"), Target.Value) > 1 Then '如果该值已出现在程序运行之前 Dim cel As Range For Each cel In Range("A1:" & Target.Address) '找到本次输入的位置 If cel.Address = Target.Address Then Exit For '如果发现重复的值，则删除本次输入 If cel.Value = Target.Value Then Application.EnableEvents = False '禁用事件处理 Target.ClearContents '删除重复的输入值 Application.EnableEvents = True '启用事件处理 Exit Sub End If Next cel '弹出消息框 MsgBox "该值已存在于单元格 " & Range("A:A").Find(Target.Value).Address & " 中。" '将光标定位到已有值所在的单元格 Range("A:A").Find(Target.Value).Select End If End If End Sub 这段代码有问题，在已有的值上个单元格输入重复值会提示单不会删除，在已有值的下方输入重复值会删除单不会提示，帮我优化这段代码

以下是优化后的代码，能够解决上面提到的问题：

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range
    Set KeyCells = Range("A:A") '要监视的列范围
    
    If Not Application.Intersect(KeyCells, Target) Is Nothing Then
        '如果目标单元格位于指定列中，请执行以下操作
        If WorksheetFunction.CountIf(Range("A:A"), Target.Value) > 1 Then
            '如果该值已出现在程序运行之前
            Dim cel As Range
            For Each cel In Range("A1:A" & Target.Row - 1)
                '找到本次输入的位置
                If cel.Address = Target.Address Then Exit For
                '如果发现重复的值，则删除本次输入，弹出消息框，将光标定位到已有值所在的单元格
                If cel.Value = Target.Value Then
                    Application.EnableEvents = False '禁用事件处理
                    Target.ClearContents '删除重复的输入值
                    Application.EnableEvents = True '启用事件处理
                    MsgBox "该值已存在于单元格 " & cel.Address & " 中。"
                    cel.Select
                    Exit Sub
                End If
            Next cel
            '如果没有重复的值，弹出消息框，将光标定位到已有值所在的单元格
            MsgBox "该值已存在于单元格 " & Range("A:A").Find(Target.Value).Address & " 中。"
            Range("A:A").Find(Target.Value).Select
        End If
    End If
End Sub

主要修改如下：

1. 在 `For Each cel In Range("A1:A" & Target.Row - 1)` 中，限制循环范围只到本次输入的上方单元格，这样可以避免删除已有值的问题。

2. 在 `If cel.Value = Target.Value Then` 中，添加弹出消息框和光标定位的代码，以便提示用户和方便用户操作。

3. 在 `If WorksheetFunction.CountIf(Range("A:A"), Target.Value) > 1 Then` 的条件判断中，如果没有重复的值，也需要弹出消息框和将光标定位到已有值所在的单元格。