Vermeidung von doppelten Einträgen

Forumthread: Vermeidung von doppelten Einträgen

16.01.2014 20:53:07

doppelten

Hallo!
Ich habe folgendes Problem.
In Spalte B trage ich Zahlen ein, dabei möchte ich doppelte Einträge vermeiden. Folgender Code klappt auch super:
Option Explicit

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("b65536")), Range("b65536").End(xlUp).Row, 65536)
Set BereichA = Range("b4:b" & lngLetzteZeileA - 1)
Set rngSuchBereich = BereichA.Find(Target.Value, LookIn:=xlValues, LookAt:=xlWhole)
If Not rngSuchBereich Is Nothing Then
MsgBox "Wert bereits vorhanden in Spalte B Zeile " & rngSuchBereich.Row
Target.ClearContents
End If
Set rngSuchBereich = Nothing
Set BereichA = Nothing
End Sub

In Spalte D trage zusätzlich das Jahr ein. Da ich einige Jahreszahlen auch in der Spalte B schon erfasst habe, z.B 2010, kann ich in einer neuen Zelle diese nicht erbneut erfassen.
Was muss ich ändern oder ergänzen?

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

AW: Vermeidung von doppelten Einträgen

17.01.2014 12:21:19

doppelten

AW: Vermeidung von doppelten Einträgen

17.01.2014 12:21:19

doppelten

Hallo Schmidt,
müsste dann etwa wie folgt aussehen. Dabei erfolgen für die Spalten B und D unterschiedliche Prüfungen.
Gruß
Franz

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lngLetzteZeileA As Long, lngLetzteZeile2 As Long
Dim rngSuchBereich As Range
Dim BereichA As Range
If Target.Count > 1 Then Exit Sub
If Target.Row = 4 Then
MsgBox "Wert bereits vorhanden in Spalte B Zeile " _
& rngSuchBereich.Row
Target.ClearContents
End If
Case 4 'Spalte D
lngLetzteZeileA = IIf(IsEmpty(Cells(Rows.Count, 2)), _
Cells(Rows.Count, 2).End(xlUp).Row, Rows.Count)
lngLetzteZeile2 = IIf(IsEmpty(Cells(Rows.Count, 4)), _
Cells(Rows.Count, 4).End(xlUp).Row, Rows.Count)
'Bereich Spalte B durchsuchen
Set BereichA = Range("b4:b" & lngLetzteZeileA)
Set rngSuchBereich = BereichA.Find(Target.Value, _
LookIn:=xlValues, LookAt:=xlWhole)
If Not rngSuchBereich Is Nothing And lngLetzteZeileA >= 4 Then
MsgBox "Wert bereits vorhanden in Spalte B Zeile " _
& rngSuchBereich.Row
Target.ClearContents
Else
If lngLetzteZeile2 > 4 Then
'Bereich Spalte D durchsuchen
Set BereichA = Range("D4:D" & lngLetzteZeile2 - 1)
Set rngSuchBereich = BereichA.Find(Target.Value, _
LookIn:=xlValues, LookAt:=xlWhole)
If Not rngSuchBereich Is Nothing Then
MsgBox "Wert bereits vorhanden in Spalte D Zeile " _
& rngSuchBereich.Row
Target.ClearContents
End If
End If
End If
End Select
Set rngSuchBereich = Nothing
Set BereichA = Nothing
End Sub

Beliebteste Forumthreads (12 Monate)

Vermeidung von doppelten Einträgen

Forumthread: Vermeidung von doppelten Einträgen

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread