Doppelte Einträge per VBA verhindern

Computer: Software & Programmierung Office Software
1

Guten Morgen zusammen,

ich möchte mittels VBA verhindern, dass doppelte Einträge möglich sind.

Meine Daten befinden sich in den zellen E8-E161.

Dazu habe ich folgende Lösungen gefunden.

  1. Private Sub Worksheet_Change(ByVal Target As Range)
    Dim lngLetzteZeileA As Long
    Dim rngSuchBereich As Range
    Dim BereichA As Range

If Target.Count > 1 Then Exit Sub

lngLetzteZeileA = IIf(IsEmpty(Range(„A65536“)), Range(„A65536“).End(xlUp).Row, 65536)
Set BereichA = Range(„A1:A“ & lngLetzteZeileA - 1)

Set rngSuchBereich = BereichA.Find(Target.Value, LookIn:=xlValues, LookAt:=xlWhole)

If Not rngSuchBereich Is Nothing Then
MsgBox "Wert bereits vorhanden in Spalte A Zeile " & rngSuchBereich.Row
Target.ClearContents
Exit Sub
End If

Set rngSuchBereich = Nothing
Set BereichA = Nothing

End Sub

  1. Private Sub Worksheet_Change(ByVal Target As Range)
    Dim lngLetzteSpalteAOB As Long
    Dim rngSuchBereich As Range
    Dim Bereich5 As Range

If Target.Count > 1 Then Exit Sub

lngLetzteSpalteAOB = Range(„AOB5“).End(xlToLeft).Column
Set Bereich5 = Range(„K5“, Cells(5, lngLetzteSpalteAOB - 1))
Set rngSuchBereich = Bereich5.Find(Target.Value, LookIn:=xlValues, LookAt:=xlWhole)

If Not rngSuchBereich Is Nothing Then
MsgBox "Wert bereits vorhanden in Zeile 5 Spalte " & rngSuchBereich.Column
Target.ClearContents
Exit Sub
End If

Set rngSuchBereich = Nothing
Set Bereich5 = Nothing

End Sub

Leider funktioniert keiner der beiden Codes bei mir. Der Fehler stellt sich so dar,dass ich nicht mehr weiterarbeiten kann.

Ich habe sowohl die Origina-Codes als auch den für meine Spalte E angepassten Code probiert.

Wo liegt hier der Fehler?

Lg Frank

2

Hallo Frank,

E8:E161 markieren, Daten—Gültigkeit—Benutzerdefiniert, Formel ist
=ZÄHLENWENN($E$8:blush:E$161;E18)=1

Oder halt so:

Private Sub Worksheet\_Change(ByVal Target As Range)
If Target.Count \> 1 Then Exit Sub
If Target.Row \> 161 Or Target.Row 5 Then Exit Sub
If Target.Value = "" Then Exit Sub
If Application.CountIf(Range("E8:E161"), Target.Value) \> 1 Then
 Application.EnableEvents = False
 MsgBox Target.Value & " ist doppelt"
 Target.ClearContents
 Target.Select
 Application.EnableEvents = True
End If
End Sub

Gruß
Reinhard

3

Hallo Reinhard,

danke für die Lösung. Funktionier mal wieder einwandfrei. Habe in der Zwischenzeit noch eine Lösung gefunden.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Bereich As Range
Set Bereich = Range(„E8:E161“)
If Target.Cells.Count > 1 Then Exit Sub
If Target.Value = „“ Then Exit Sub
If Intersect(Bereich, Target) Is Nothing Then Exit Sub
If WorksheetFunction.CountIf(Bereich, Target.Value) > 1 Then
MsgBox („Dieser Name ist schon vorhanden“)
Application.EnableEvents = False
Target.Value = „“
Application.EnableEvents = True
Target.Select
End If
End Sub

Worin liegt jetzt der Unterschied?

Lg Frank

P.S. VBA…für mich ein Buch mit 14 Siegeln…

4

Hallo Frank,

Worin liegt jetzt der Unterschied?

würdest du beim Posten und im Modul Einrückungen im Code machen mit Leerzeichen und hier den Button „pre“ benutzen siehst du besser daß die Codes eher ähnlich als unterschiedlich sind.
Viele Wege führen nach Rom :smile:

Wichtige Gründe hier die eine oder andere variante zu benutzen sehe ich hier nicht.

P.S. VBA…für mich ein Buch mit 14 Siegeln…

War für mich auch so früher. Fang mit dem ersten Siegel an und knacke es.
Vergleiche beide Codes, analysiere was sie tun und warum sie es tun.
Wenn du glaubst du hast es verstanden, dann nimm eine neue leere mappe gehe dort ins Modul Tabellenblatt1 und bastle selbst einen Code der das tun soll wie die beiden anderen auch.
Natürlich ohne dabei in den anderen Codes reinzuschauen *gg*

Wenn was nicht klappt macht das gar nix, setze dann einen haltepunkt ziemlich weit oben im Code, dann schreib halt was in die tabelle, egal in E8:E161 oder auch zum Test ußerhalb und dann muß der Code angezeigt werden und die Haltepunkt-Zeile ist gelb. Gehe dann mit F8 den Code weiter und beobachte was geschieht…

Sollte der Code mal überhaupt ncht mehr reagieren auf Eingaben ins Blatt so laß mal dieses Makro laufen

sub Ein()
Application.EnableEvents = True
end sub

Gruß
Reinhard

5

Grüezi Frank

E8:E161 markieren, Daten—Gültigkeit—Benutzerdefiniert,
Formel ist
=ZÄHLENWENN($E$8:blush:E$161;E18)=1

Das hier würde ich jeder VBA-Programmierung vorziehen!

…es wird nicht ‚besser‘ nur weil VBA drauf steht… :wink:

Mit freundlichen Grüssen

Thomas Ramel

  • MVP für MS-Excel -
6

Korrektur
Grüezi Thomas,

E8:E161 markieren, Daten—Gültigkeit—Benutzerdefiniert,
Formel ist
=ZÄHLENWENN($E$8:blush:E$161;E18)=1

Das hier würde ich jeder VBA-Programmierung vorziehen!
…es wird nicht ‚besser‘ nur weil VBA drauf steht… :wink:

*zustimm* (naja, Vba macht mir mehr Spass *gg*)

In der Formel ist ein Fehler, so muß es aussehen wenn man in E8 stand und bis nach E161 erweitert hat:

E8:E161 markieren, Daten—Gültigkeit—Benutzerdefiniert, Formel ist
=ZÄHLENWENN($E$8:blush:E$161;E 8 )=1

Gruß
Reinhard