Office: suchen in Listbox

Karl-Heinz · 14. Mai 2015

Hallo Fangemeinde,
ich hab wiedermal in Problem mit Excel.
In einem UserForm habe ich eine Listbox mit mehreren Spalten hier das befüllen
Code:

Private Sub UserForm_Initialize()
Dim lZeile As Long

ListBox1.Clear
ListBox1.ColumnCount = 4
'Breite der Spalten in ListBox
ListBox1.ColumnWidths = "3cm; 6cm;0cm;0cm"
lZeile = 2
Do While Tabelle3.Cells(lZeile, 1).Value ""
ListBox1.AddItem Tabelle3.Cells(lZeile, 1).Value
ListBox1.List(ListBox1.ListCount - 1, 1) = Cells(lZeile, 4).Value
ListBox1.List(ListBox1.ListCount - 1, 2) = Cells(lZeile, 2).Value
ListBox1.List(ListBox1.ListCount - 1, 3) = Cells(lZeile, 5).Value
lZeile = lZeile + 1
Debug.Print lZeile
Loop
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

nun will ich Datensätze aus dieser Listbox suchen und anzeigen lassen.
dafür hab ich ein Programm aus dem Internet
Code:

Private Sub CommandButton5_Click()
Dim i As Integer, ii As Integer
Dim vntList, strTxt As String, arrSelected()
strTxt = LCase(TextBox6)
vntList = ListBox1.List
ReDim arrSelected(ListBox1.ListCount - 1)
For i = 0 To ListBox1.ListCount - 1
For ii = 0 To ListBox1.ColumnCount - 1
arrSelected(i) = InStr(LCase(vntList(i, ii)), strTxt) > 0
If arrSelected(i) Then Exit For
Next
Next
With ListBox1
For i = 0 To .ListCount - 1
.Selected(i) = arrSelected(i)
Next
End With

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

dieser Code funktioniert auch. Aber ich hab zwei Probleme
Ich kann nicht mit Joker "*" suchen. Es handelt sich um eine Adressdatei, habe aber nicht immer einen eindeutigen Begriff wie Kundennummer da so will ich dann wie folgt suchen mal mit namen und Strasse oder Namen PLZ etc.
jetzt kommt mein zweites Problem zu tage ich kann nur eine Fundstelle sehen ich möchte gern entweder das alle Fundstellen makiert sind oder die Listbox nur noch die gefundenen Datensätze anzeigt.
Ich hoffe das jemand mir helfen kann.

Karl-Heinz

:)

Nepumuk · 16. Mai 2015

Hallo,

es wäre schön, wenn du eine Mustermappe zur Verfügung stellen würdest.

Karl-Heinz · 16. Mai 2015

Hallo,
jetzt habe ich eine Musterdatei hochgeladen,
Wenn ich im Suchfeld 99999 eingebe sollen beide Datensätze gefunden werden
Auch soll nach Muster*Berg* gesucht werden können
100000 Peter Mustermann Bergstr.45 99999 Musterhausen Peter@Mustermann.it
002365 Petra Wenig Talstr.12 01221 Testhausen 078985/544455 Wenig@aol.de
565544 Paul Muster Bergweg 2 99999 Musterhausen 05887/45458
gefunden werden soll dann Peter Mustermann und Paul Muster

Karl-Heinz

Nepumuk · 16. Mai 2015

Hallo,

ich konnte es nicht lassen deinen Code etwas zu optimieren. *Smilie

Code:

Option Explicit
Option Compare Text

Private Sub CommandButton1_Click()
Unload Me
End Sub

Private Sub CommandButton2_Click()

Dim lngRow As Long, lngColumn As Long
Dim strSearchText As String

If Trim$(TextBox9.Text) "" Then

strSearchText = "*" & Trim$(TextBox9.Text) & "*"

With ListBox1
.MultiSelect = fmMultiSelectMulti
For lngRow = 0 To .ListCount - 1
.Selected(lngRow) = False
For lngColumn = 0 To .ColumnCount - 1
If .List(lngRow, lngColumn) Like strSearchText Then
.Selected(lngRow) = True
Exit For
End If
Next
Next
End With
End If
End Sub

Private Sub ListBox1_Click()
Dim lngRow As Long, lngIndex As Long
If ListBox1.ListIndex >= 0 Then
lngRow = ListBox1.ListIndex + 2
With Tabelle1
For lngIndex = 1 To 8
Controls("TextBox" & CStr(lngIndex)).Text = _
.Cells(lngRow, lngIndex).Value
Next
End With
End If
End Sub

Private Sub ListBox1_MouseDown( _
ByVal Button As Integer, _
ByVal Shift As Integer, _
ByVal X As Single, _
ByVal Y As Single)
ListBox1.MultiSelect = fmMultiSelectSingle
End Sub

Private Sub TextBox9_KeyDown( _
ByVal KeyCode As MSForms.ReturnInteger, _
ByVal Shift As Integer)
If KeyCode = vbKeyReturn Then CommandButton2.Value = True
End Sub

Private Sub UserForm_Initialize()

Dim avntValues As Variant
Dim ialngIndex As Long

With Tabelle1
avntValues = .Range(.Cells(2, 1), .Cells( _
.Rows.Count, 1).End(xlUp).Offset(0, 6)).Value
End With

With ListBox1
.ColumnCount = 6
.ColumnWidths = "2cm; 2cm;1cm;0cm;0 cm;0cm"
For ialngIndex = LBound(avntValues) To UBound(avntValues)
.AddItem avntValues(ialngIndex, 3) 'Nachname
.List(.ListCount - 1, 1) = avntValues(ialngIndex, 2) 'Vorname
.List(.ListCount - 1, 2) = avntValues(ialngIndex, 1) 'Kundennr
.List(.ListCount - 1, 6) = avntValues(ialngIndex, 5) 'PLZ
.List(.ListCount - 1, 4) = avntValues(ialngIndex, 6) 'Ort
.List(.ListCount - 1, 5) = avntValues(ialngIndex, 4) 'Strasse
Next
End With
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Karl-Heinz · 16. Mai 2015

Einfach Klasse,
du zauberst. Ich versuch jetzt einmal deinen super Code zu verstehen.
Vielen Dank

Excellyzer74 · 12. Januar 2021

von Nepumuk

Hallo,

ich konnte es nicht lassen deinen Code etwas zu optimieren. *Smilie

Code:
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Option Explicit
Option Compare Text

Private Sub CommandButton1_Click()
Unload Me
End Sub

Private Sub CommandButton2_Click()

Dim lngRow As Long, lngColumn As Long
Dim strSearchText As String

If Trim$(TextBox9.Text) "" Then

strSearchText = "*" & Trim$(TextBox9.Text) & "*"

With ListBox1
.MultiSelect = fmMultiSelectMulti
For lngRow = 0 To .ListCount - 1
.Selected(lngRow) = False
For lngColumn = 0 To .ColumnCount - 1
If .List(lngRow, lngColumn) Like strSearchText Then
.Selected(lngRow) = True
Exit For
End If
Next
Next
End With
End If
End Sub

Private Sub ListBox1_Click()
Dim lngRow As Long, lngIndex As Long
If ListBox1.ListIndex >= 0 Then
lngRow = ListBox1.ListIndex + 2
With Tabelle1
For lngIndex = 1 To 8
Controls("TextBox" & CStr(lngIndex)).Text = _
.Cells(lngRow, lngIndex).Value
Next
End With
End If
End Sub

Private Sub ListBox1_MouseDown( _
ByVal Button As Integer, _
ByVal Shift As Integer, _
ByVal X As Single, _
ByVal Y As Single)
ListBox1.MultiSelect = fmMultiSelectSingle
End Sub

Private Sub TextBox9_KeyDown( _
ByVal KeyCode As MSForms.ReturnInteger, _
ByVal Shift As Integer)
If KeyCode = vbKeyReturn Then CommandButton2.Value = True
End Sub

Private Sub UserForm_Initialize()

Dim avntValues As Variant
Dim ialngIndex As Long

With Tabelle1
avntValues = .Range(.Cells(2, 1), .Cells( _
.Rows.Count, 1).End(xlUp).Offset(0, 6)).Value
End With

With ListBox1
.ColumnCount = 6
.ColumnWidths = "2cm; 2cm;1cm;0cm;0 cm;0cm"
For ialngIndex = LBound(avntValues) To UBound(avntValues)
.AddItem avntValues(ialngIndex, 3) 'Nachname
.List(.ListCount - 1, 1) = avntValues(ialngIndex, 2) 'Vorname
.List(.ListCount - 1, 2) = avntValues(ialngIndex, 1) 'Kundennr
.List(.ListCount - 1, 6) = avntValues(ialngIndex, 5) 'PLZ
.List(.ListCount - 1, 4) = avntValues(ialngIndex, 6) 'Ort
.List(.ListCount - 1, 5) = avntValues(ialngIndex, 4) 'Strasse
Next
End With
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Vielen Dank auch von mir für diese excellente Lösung!
Einfach genial.

Office: suchen in Listbox

suchen in Listbox

suchen in Listbox

suchen in Listbox

suchen in Listbox - Similar Threads - Listbox

Suchfunktion für Listbox in Textbox

Listbox befüllen

Listbox füllen wenn zelle daneben leer

Ordnernamen, die Kriterien erfüllen in Listbox aufführen

Suchfunktion in Listbox

ListBox generiert selbstsändig Leerzeilen

Listenfeld in Word 2016