Excel基于Email id列的重复行自动校验VBA代码编译错误排查及功能实现咨询

Let's walk through the issues in your original code that caused the compile error and logical flaws, then jump to a working solution that meets your exact requirements:

Issues in the Original Code #

1. Syntax Error: An extra End If breaks the code's structure, triggering the compile error.
2. MsgBox Logic Mistake: You embedded the button condition (+ vbYesNo + vbDefaultButton2 = vbYes) directly in the message string instead of passing it as a valid MsgBox parameter.
3. Unrestricted Trigger: The code runs on any cell change, not just when editing column E (your Email id column).
4. Flawed Duplicate Handling: Deleting rows while looping without proper safeguards causes index misalignment, and the code doesn't distinguish between the newly entered duplicate and existing rows.
5. Missing Explicit Declarations: Undeclared variables can lead to unexpected bugs; always use Option Explicit to enforce variable declaration.

Working VBA Code #

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    ' Only run if the edited cell is in column E (Email id)
    If Intersect(Target, Me.Columns("E")) Is Nothing Then Exit Sub
    ' Avoid issues with bulk pastes/edits by only handling single cells
    If Target.Cells.Count > 1 Then Exit Sub
    
    Dim rRange As Range
    Dim emailValue As Variant
    Dim duplicateRow As Range
    Dim response As VbMsgBoxResult
    
    emailValue = Target.Value
    ' Skip validation if the cell is cleared
    If emailValue = "" Then Exit Sub
    
    ' Define the range of existing email values (from E1 to last used row)
    Set rRange = Me.Range("E1", Me.Range("E" & Me.Rows.Count).End(xlUp))
    
    ' Find duplicates, skipping the current edited row to avoid false positives
    On Error Resume Next
    Set duplicateRow = rRange.Find(What:=emailValue, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
    Do While Not duplicateRow Is Nothing And duplicateRow.Row = Target.Row
        Set duplicateRow = rRange.FindNext(After:=duplicateRow)
    Loop
    On Error GoTo 0
    
    If Not duplicateRow Is Nothing Then
        ' Highlight the existing duplicate row
        duplicateRow.EntireRow.Interior.ColorIndex = 27
        
        ' Prompt user to delete the duplicate
        response = MsgBox("You Enter Duplicate Data is Already Exist See Row has Highlighted" & vbNewLine & "If you want delete duplicate click (yes)", vbYesNo + vbDefaultButton2, "Duplicate Entry Found")
        
        ' Delete the duplicate if user confirms, disable events to avoid loop
        If response = vbYes Then
            Application.EnableEvents = False
            duplicateRow.EntireRow.Delete
            Application.EnableEvents = True
            MsgBox "Duplicate Entry Deleted", vbInformation, "Success"
        End If
    End If
End Sub

Key Improvements Explained #

• Targeted Trigger: The code only runs when editing column E, and only for single-cell edits to avoid chaos with bulk pastes.
• Proper MsgBox Handling: Separates the message text from button parameters, and correctly captures the user's response.
• Safe Deletion: Temporarily disables worksheet events when deleting a row to prevent the Worksheet_Change event from triggering repeatedly.
• Accurate Duplicate Detection: Skips the current edited row when searching for duplicates, so editing an existing email doesn't trigger a false alert.
• Empty Value Check: Bypasses validation if the user clears an email cell.

内容的提问来源于stack exchange，提问作者visshnu