Wie kann man in Excel VBA nach doppelten Werten suchen?

Question

Datenüberprüfungen in Excel funktionieren nicht, wenn der Benutzer die Daten kopiert und einfügt.

Ich möchte, dass eine Fehlermeldung ausgegeben wird, wenn der Benutzer doppelte Daten in eine Spalte einfügt.

Ich verwende den folgenden Code (eine andere Alternative), aber das ist nicht das, was ich will. Ich möchte, dass dies überprüft wird, wenn der Benutzer die Daten eingibt, und dass bei Problemen eine Fehlermeldung ausgegeben wird.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) 
  Dim rngCell As Range Dim lngLstRow As Long lngLstRow = Sheet1.UsedRange.Rows.Count
  For Each rngCell In Sheet1.Range("A1:A" & lngLstRow) 
    If CountIf(Range("A:A"),A1) > 2 Then
      MsgBox "Please enter unique value " & rngCell.Address
        rngCell.Select
    End If 
  Next 
End Sub

Answer 1

Mithilfe des ChangeEreignisses können wir doppelte Einträge ohne Datenüberprüfung abfangen:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim RangeOfInterest As Range, Intersection As Range, cell As Range
    
    Set RangeOfInterest = Range("A:A")
    Set Intersection = Intersect(RangeOfInterest, Target)
    If Intersection Is Nothing Then Exit Sub
    
    With Application
        For Each cell In Intersection
            If .WorksheetFunction.CountIf(RangeOfInterest, cell.Value) > 1 Then
                .EnableEvents = False
                    .Undo
                .EnableEvents = True
                MsgBox "duplicates not allowed"
            Exit Sub
            End If
        Next cell
    End With
End Sub

NOTIZ:

1. Der Code kann sowohl eingegebene Einträge in der Spalte verarbeitenAsowie Kopieren/Einfügen in die Spalte
2. Der Code kann das Kopieren/Einfügen mehrerer Zellen in die Spalte verarbeiten.