ich habe auf einer Userform zwei Textboxen für Vor-und Familienname, zudem ein Listenfeld welches in Spalte 1 Einträge zu Prozessen hat.
Diese Einträge sollen in eine Tabelle zurückgeschrieben werden, jedoch zuvor auf doppelte Einträge geprüft werden.
Heißt, wenn zu Vor-und Familienname + Prozess bereits ein Eintrag vorhanden ist dann Info, falls nicht, dann neuen Zeilen Eintrag.
Bisher war an der Stelle des Listenfeldes eine Combobox, mit der funktionierte die Prüfung auf doppelte Einträge perfekt, mit hinzufügen des Listenfeldes funktioniert dies leider nicht mehr.
Wer kann mir dabei helfen, es auf die Listbox anzupassen!?
Private Sub commandbutton2_click()
Dim Ausführen As Boolean
Dim i As Long
Dim Leerzeile As Long
Ausführen = True
If Vorname.Text = "" Then Ausführen = False
If Familienname.Text = "" Then Ausführen = False
If Kuerzel.Text = "" Then Ausführen = False
If Datum.Text = "" Then Ausführen = False
If Bereich.Text = "" Then Ausführen = False
If Prozess.ListIndex = -1 Then Ausführen = False
If WorksheetFunction.CountIfs(Worksheets("Datenbank").Columns(1), Vorname & " " & Familienname, _
Worksheets("Datenbank").Columns(5), Prozess.List(i, 1)) Then
MsgBox " Eintrag schon vorhanden, bitte prüfen"
Exit Sub
End If
If Ausführen Then
Leerzeile = 2
Do While Worksheets("Datenbank").Cells(Leerzeile, 1).Value Empty
Leerzeile = Leerzeile + 1
Loop
Sheets("Datenbank").Cells(Leerzeile, 1) = Vorname.Value & " " & Familienname
Sheets("Datenbank").Cells(Leerzeile, 2) = Kuerzel.Value
Sheets("Datenbank").Cells(Leerzeile, 3) = Datum.Value
Sheets("Datenbank").Cells(Leerzeile, 4) = Bereich.Value
Sheets("Datenbank").Cells(Leerzeile, 6) = Label7.Caption
Sheets("Datenbank").Cells(Leerzeile, 7) = Label10.Caption
Sheets("Datenbank").Cells(Leerzeile, 8) = "anlernen"
Sheets("Datenbank").Cells(Leerzeile, 11) = "aktiv"
With Prozess
For i = 0 To .ListCount - 1
If .Selected(i) Then
Sheets("Datenbank").Cells(Rows.Count, 5).End(xlUp).Offset(1) = .List(i, 1)
End If
Next i
End With
MsgBox "Daten erfolgreich übernommen"
Unload UserForm1
Application.ScreenUpdating = False
Unload UserForm4
UserForm4.Show
ActiveWorkbook.Save
Else
MsgBox "Bitte alle Felder vollständig ausfüllen."
End If
End Sub