Hallo Vinie,
für UserformSuchen muss die die FindNext-ANweisung etwas anpassen.
Im UserFormAendern muss du eine Userform_Activate-Ereignisprozedur einfügen in der die Daten aus der Tabelle geladen werden. Dabei sind die Anweisungen der OK-Button-Prozedur am Gleichheitszeichen zu spiegeln.
Nicht so schön gelöst hast du Vielzahl der Combobox-Auswahllisten. Es ist meiner Meinung nach eleganter, alle statischen Listen in einem separaten Tabellenblatt anzulegen, den entsprechenden Zellbereichen Namen zuzuweisen und im Userform-Edtor dann unter der RowSource-Eigenschaft der Comboboxen den entsprechenden Namen einzutragen. Du kannst dann auf die vielen AddItem-Anweisungen in der Initialiiserungsprozedur verzichten. Außerdem ist es einfacher/übersichtlicher, diese Daten in einem Tabellenblatt zu pflegen/anzupassen als im VBA-Code. Wenn es sein muss kann man dieses Tabellenblatt auch ausblenden oder schützen.
Gruß
Franz
'Im Code von UserFormAendern ergänzen
Private Sub UserForm_Activate()
Dim rng As Range
With Sheets("Tabelle2")
Set rng = .Range("B:B").Find(CStr(lblID.Caption), LookIn:=xlValues, LookAt:=xlWhole)
If Not rng Is Nothing Then 'Wenn ID gefunden
Kategorie.Text = .Cells(rng.Row, 3)
' Kategorie.Text = UserFormSuchen.LBErgebnisse.List(UserFormSuchen.LBErgebnisse.ListIndex, _
1)
Firma.Text = .Cells(rng.Row, 4)
' Firma.Text = UserFormSuchen.LBErgebnisse.List(UserFormSuchen.LBErgebnisse.ListIndex, 2)
Straße.Text = .Cells(rng.Row, 6)
PLZ.Text = .Cells(rng.Row, 7).Text
Ort.Text = .Cells(rng.Row, 8)
' Ort.Text = UserFormSuchen.LBErgebnisse.List(UserFormSuchen.LBErgebnisse.ListIndex, 3)
Staat.Text = .Cells(rng.Row, 9)
EMail.Text = .Cells(rng.Row, 10)
' ##### usw. bei den restlichen Zeilen links und rechts vom Gleichheitszeichen _
vertauschen. Ggf. die Text-Eigenschaft der Zellen zuweisen. ####
.Cells(rng.Row, 11) = Homepage.Text
.Cells(rng.Row, 12) = TelNr.Text
.Cells(rng.Row, 13) = Fax.Text
.Cells(rng.Row, 14) = Branche.Text
.Cells(rng.Row, 15) = Betreuer.Text
UserFormSuchen.LBErgebnisse.List(UserFormSuchen.LBErgebnisse.ListIndex, 4) = Betreuer. _
Text
.Cells(rng.Row, 16) = AP1_Titel.Text
.Cells(rng.Row, 17) = AP1_Vorname.Text
.Cells(rng.Row, 18) = AP1_Nachname.Text
UserFormSuchen.LBErgebnisse.List(UserFormSuchen.LBErgebnisse.ListIndex, 5) = AP1_Nachname. _
Text
.Cells(rng.Row, 19) = Position1.Text
.Cells(rng.Row, 20) = EMail1.Text
.Cells(rng.Row, 21) = TelNr1.Text
.Cells(rng.Row, 22) = Fax1.Text
.Cells(rng.Row, 23) = AP2_Titel.Text
.Cells(rng.Row, 24) = AP2_Vorname.Text
.Cells(rng.Row, 25) = AP2_Nachname.Text
UserFormSuchen.LBErgebnisse.List(UserFormSuchen.LBErgebnisse.ListIndex, 6) = AP2_Nachname. _
Text
.Cells(rng.Row, 26) = Position2.Text
.Cells(rng.Row, 27) = EMail2.Text
.Cells(rng.Row, 28) = TelNr2.Text
.Cells(rng.Row, 29) = Fax2.Text
.Cells(rng.Row, 30) = AP3_Titel.Text
.Cells(rng.Row, 31) = AP3_Vorname.Text
.Cells(rng.Row, 32) = AP3_Nachname.Text
UserFormSuchen.LBErgebnisse.List(UserFormSuchen.LBErgebnisse.ListIndex, 7) = AP3_Nachname. _
Text
.Cells(rng.Row, 33) = Position3.Text
.Cells(rng.Row, 34) = EMail3.Text
.Cells(rng.Row, 35) = TelNr3.Text
.Cells(rng.Row, 36) = Fax3.Text
.Cells(rng.Row, 36) = Kontaktinfo.Text
.Cells(rng.Row, 37) = letzterKontakt.Text
.Cells(rng.Row, 38) = geplanteAktion.Text
.Cells(rng.Row, 40) = Aufgabe.Text
.Cells(rng.Row, 41) = WV.Text
UserFormSuchen.LBErgebnisse.List(UserFormSuchen.LBErgebnisse.ListIndex, 8) = WV.Text
End If
End With
Set rng = Nothing
End Sub
'##### im Userform UserformSuchen anpassen #####
Private Sub CB_Suchen01_Click()
Dim rng As Range
Dim sFirst As String
Dim lngI As Long
With LBErgebnisse
.Clear
If Len(textboxSuchen01) > 0 Then
'Suchen in Range "C6:AS65536"
Set rng = Sheets("Tabelle2").Range("C6:AS65536").Find(textboxSuchen01 & "*", LookIn:= _
xlValues, LookAt:=xlWhole)
If Not rng Is Nothing Then
sFirst = rng.Address
Do
.AddItem Sheets("Tabelle2").Cells(rng.Row, 2).Text
.List(.ListCount - 1, 2) = Sheets("Tabelle2").Cells(rng.Row, 3).Text 'Kategorie
.List(.ListCount - 1, 3) = Sheets("Tabelle2").Cells(rng.Row, 4).Text 'Firmaname
.List(.ListCount - 1, 4) = Sheets("Tabelle2").Cells(rng.Row, 8).Text 'Ort
.List(.ListCount - 1, 5) = Sheets("Tabelle2").Cells(rng.Row, 15).Text 'Betreuer
.List(.ListCount - 1, 6) = Sheets("Tabelle2").Cells(rng.Row, 19).Text 'AP_1 Name
.List(.ListCount - 1, 7) = Sheets("Tabelle2").Cells(rng.Row, 27).Text 'AP_2 Name
.List(.ListCount - 1, 8) = Sheets("Tabelle2").Cells(rng.Row, 35).Text 'AP_3 Name
.List(.ListCount - 1, 9) = Sheets("Tabelle2").Cells(rng.Row, 45).Text 'WV
'Suche nach Zelle in Spalte AS der Zeile mit Fundstelle fortsetzen
With Sheets("Tabelle2")
Set rng = .Range("C6:AS65536").FindNext(.Cells(rng.Row, 45))
End With
Loop While Not rng Is Nothing And sFirst rng.Address
Else
MsgBox "Suche ohne Ergebnis abgeschlossen!", 64, "Hinweis"
End If
End If
End With
setColCountAndWidth LBErgebnisse, LBErgebnisse.List
End Sub