Verhindern doppelter Einträge in einem Bereich
Im folgenden Codebeispiel wird überprüft, ob ein in den Bereich A1:B20 eingegebener Wert innerhalb dieses Bereichs auf einem der Arbeitsblätter in der aktuellen Arbeitsmappe vorhanden ist, und verhindert doppelte Einträge, wenn der Wert vorhanden ist.
Beispielcode bereitgestellt von: Holy Macro! Books, Holy Macro! It's 2,500 Excel VBA Examples
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'Define your variables.
Dim ws As Worksheet, EvalRange As Range
'Set the range where you want to prevent duplicate entries.
Set EvalRange = Range("A1:B20")
'If the cell where value was entered is not in the defined range, if the value pasted is larger than a single cell,
'or if no value was entered in the cell, then exit the macro.
If Intersect(Target, EvalRange) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
If IsEmpty(Target) Then Exit Sub
'If the value entered already exists in the defined range on the current worksheet, throw an
'error message and undo the entry.
If WorksheetFunction.CountIf(EvalRange, Target.Value) > 1 Then
MsgBox Target.Value & " already exists on this sheet."
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
End If
'Check the other worksheets in the workbook.
For Each ws In Worksheets
With ws
If .Name <> Target.Parent.Name Then
'If the value entered already exists in the defined range on the current worksheet, throw an
'error message and undo the entry.
If WorksheetFunction.CountIf(Sheets(.Name).Range("A1:B20"), Target.Value) > 0 Then
MsgBox Target.Value & " already exists on the sheet named " & .Name & ".", _
16, "No duplicates allowed in " & EvalRange.Address(0, 0) & "."
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
Exit For
End If
End If
End With
Next ws
End Sub
Über den Autor
Holy Macro! Books veröffentlicht unterhaltsame Bücher für Benutzer von Microsoft Office. Den kompletten Katalog finden Sie unter MrExcel.com.
Support und Feedback
Haben Sie Fragen oder Feedback zu Office VBA oder zu dieser Dokumentation? Unter Office VBA-Support und Feedback finden Sie Hilfestellung zu den Möglichkeiten, wie Sie Support erhalten und Feedback abgeben können.
Feedback
https://aka.ms/ContentUserFeedback.
Bald verfügbar: Im Laufe des Jahres 2024 werden wir GitHub-Issues stufenweise als Feedbackmechanismus für Inhalte abbauen und durch ein neues Feedbacksystem ersetzen. Weitere Informationen finden Sie unterFeedback senden und anzeigen für