06.01.2018, 15:26
Hallo Joachim
es freut mich sehr das mein Code zufriedenstellend laeuft. Das Jahr faengt gut an .....
Hier noch mal die Aenderung für Strasse, einfach ins Modul1 kopieren. Das ist alles.
Ich habe noch die Löschen Anweisung mit "Ja" (Nein) eingefügt. Da kann man selbst festlegen ob die Fehleingabe gelöscht werden soll oder nicht.
mfg Gast 123
es freut mich sehr das mein Code zufriedenstellend laeuft. Das Jahr faengt gut an .....
Hier noch mal die Aenderung für Strasse, einfach ins Modul1 kopieren. Das ist alles.
Ich habe noch die Löschen Anweisung mit "Ja" (Nein) eingefügt. Da kann man selbst festlegen ob die Fehleingabe gelöscht werden soll oder nicht.
mfg Gast 123
Code:
Public FamName As String
Public Vorname As String
Public GebDatum As Date
Public TSpalte As Long
Public TZeile As Long
Const Löschen = "Ja" 'Ja/Nein Option
'Modul zum Prüfen von vorhandenen Namen
Sub Prüfung()
Dim rFind As Range, Zeile As Long
Dim gFind As Range, Adr1 As String
Dim Strasse As String
On Error GoTo Fehler
'Vorname und Fam.Name suchen
Set rFind = Columns("C").Find(What:=FamName, after:=Range("C1"), LookIn:= _
xlValues, LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=True)
If Not rFind Is Nothing Then Adr1 = rFind.Address: Zeile = rFind.Row
'Vorname und Fam.Name beide vorhanden ?? Ende!!
If TSpalte = 4 And TZeile > Zeile Then
Strasse = Cells(TZeile, 5)
Do
If Cells(rFind.Row, "C") = FamName And _
Cells(rFind.Row, "D") = Vorname And _
Cells(rFind.Row, "E") = Strasse Then
MsgBox "Dieser Familien Name und Vorname existiert bereits in Zeile: " & rFind.Row
'Datensatz nur bei "Ja" löschen
If Löschen = "Ja" Then
Cells(TZeile, 2).Resize(1, 6) = Empty '6 Spalten löschen
Cells(TZeile, 2).Activate: Exit Sub
End If
End If
Set rFind = Columns("C").FindNext(after:=rFind)
Loop Until Adr1 = rFind.Address
End If
'Ged.Datum suchen, wenn vorhanden!!
If TSpalte = 7 And TZeile > Zeile Then
GebDatum = Cells(TZeile, 7)
Set gFind = Columns("G").Find(What:=GebDatum, after:=Range("G1"), LookIn:= _
xlValues, LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=True)
If Not gFind Is Nothing Then Adr1 = gFind.Address: Zeile = gFind.Row
End If
If TSpalte = 7 And Not gFind Is Nothing Then
'Geb.Datum, Vorname und Fam.Name alle vorhanden ?? Ende!!
Do
If Cells(gFind.Row, "C") = FamName And _
Cells(gFind.Row, "D") = Vorname Then
MsgBox "Dieser Datensatz existiert bereits in Zeile: " & rFind.Row
'Datensatz nur bei "Ja" löschen
If Löschen = "Ja" Then
Cells(TZeile, 2).Resize(1, 6) = Empty '6 Spalten löschen
Cells(TZeile, 2).Activate: Exit Sub
End If
End If
Set gFind = Columns("G").FindNext(after:=gFind)
Loop Until Adr1 = gFind.Address
End If
Fehler:
End Sub