AW: Listbox füllen nach Übereinstimmungen
07.10.2014 15:17:15
fcs
Hallo Dirk,
hier ein entsprechender Code für das Userform.
Die Listboxauswahl wird bei jeder Eingabe eines Zeichens in die Textboxen für Nachname/Vorname aktualisiert.
Bei Klick auf einen Listbox eintrag werden die Textboxen mit den zugehörigen Daten gefüllt.
Gruß
Franz
'Code für Userform "Kontaktinfos"
Option Explicit
Private arrData, wksData As Worksheet
Private bolNoAction As Boolean
Private Sub prcFillListbox()
If bolNoAction = True Then Exit Sub
Dim strNN As String, strVN As String
Dim arrListe, lngJ As Long, lngL As Long, Spalte As Long
strNN = LCase(Me.TextBox2.Value)
strVN = LCase(Me.TextBox3.Value)
ReDim arrListe(1 To 13, LBound(arrData, 1) To UBound(arrData, 1))
For lngL = LBound(arrData, 1) To UBound(arrData, 1)
If LCase(Left(arrData(lngL, 3), Len(strNN))) = strNN Or strNN = "" Then 'Nachname
If LCase(Left(arrData(lngL, 4), Len(strVN))) = strVN Or strVN = "" Then 'Vorname
lngJ = lngJ + 1
For Spalte = 1 To 13
arrListe(Spalte, lngJ) = arrData(lngL, Spalte)
Next
End If
End If
Next
Me.ListBox1.Clear
If lngJ > 0 Then
ReDim Preserve arrListe(1 To 13, 1 To lngJ)
Me.ListBox1.Column = arrListe
End If
Erase arrListe
End Sub
Private Sub ListBox1_Click()
'Textfelder mit Daten der gewählten Zeile füllen
Dim Spalte As Integer
bolNoAction = True
With Me.ListBox1
For Spalte = 1 To 12 'Spalte 0 = lfd. Nr.
Me.Controls("Textbox" & Format(Spalte, "0")).Value = .List(.ListIndex, Spalte)
Next
End With
bolNoAction = False
End Sub
Private Sub TextBox2_Change()
'Nachname ändert sich
Call prcFillListbox
End Sub
Private Sub TextBox3_Change()
'Vorname ändert sich
Call prcFillListbox
End Sub
Private Sub UserForm_Initialize()
Dim lngZeile
Set wksData = ActiveWorkbook.Worksheets("Tabelle1")
'Listbox1 formatieren
With Me.ListBox1
.ColumnCount = 13
.ColumnWidths = "0Pt;35Pt;100Pt;100Pt;90Pt;35Pt;40Pt;80Pt;80Pt;80Pt;70Pt;0Pt;0Pt"
End With
'Daten von F4 bis Ende der Liste in Spalte R in Array einlesen.
With wksData
lngZeile = .Cells(.Rows.Count, 8).End(xlUp).Row
arrData = .Range(.Cells(4, 6), .Cells(lngZeile, 18))
End With
End Sub