Suchen und Funde in Listbox ausgeben
02.06.2016 14:14:26
Tom
ich habe in den letzten Tagen schon einiges auf diesen Seiten gelernt. Aber nun stoße ich an eine Grenze.
Ich habe eine Excel-Tabelle in der Eingänge gesammelt werden.
Dazu gibt es jetzt ein Userform mit einer mehrspaltigen Listbox in der die Daten zu den Suchergebnissen ausgegeben werden sollen. Der Suchbegriff wird in ein Textfeld eingegeben und ist, falls das Leer ist, standardmäßig "*". Durchsucht wir die Spalte E in der vorher die Inhalte der Zellen "Name" und "Vorname" zusammengefügt werden. Das funktioniert auch alles wunderbar.
Allerdings, und jetzt kommt das Problem was ich habe, steht der erste Fund in der Listbox immer an letzter Stelle. Alle anderen sind in der korrekten Reihenfolge nach Datum sortiert wie die Tabelle selbst.
Hier der Code dazu:
Sub Suchen()
Dim rngFund As Range
Dim rngFundZeile As Range
Dim rngSuchbereich As Range
Dim strTestBegriff As String
Dim strErsterFund As String
Dim rngletzteZeile As Range
Dim wksAktiv As Worksheet
Dim x As Integer
Dim y As Integer
ThisWorkbook.Activate
'Suchbereich festlegen
Set wksAktiv = ActiveSheet
Set rngletzteZeile = wksAktiv.UsedRange
Set rngSuchbereich = wksAktiv.Range("e5", "e" & rngletzteZeile.Rows.Count)
'Suchbereich mit Vor- und Nachnamen füllen
For x = 5 To rngletzteZeile.Rows.Count
Cells(x, 5) = Cells(x, 3) & ", " & Cells(x, 4)
Next
'Suchbegriff definieren
If strTestBegriff = "" Then
strTestBegriff = "*"
Else
strTestBegriff = frmAnlegenSuchen.txtSuchen.Value
End If
Set rngFund = rngSuchbereich.Find(strTestBegriff)
'Suche durchlaufen lassen
If Not rngFund Is Nothing Then
strErsterFund = rngFund.Address
Do
With frmAnlegenSuchen.lstSuchergebnisse
For Each rngFundZeile In rngFund.EntireRow
.AddItem rngFundZeile.Row
.Column(1, .ListCount - 1) = rngFundZeile.Cells(1)
.Column(2, .ListCount - 1) = rngFundZeile.Cells(2)
.Column(3, .ListCount - 1) = rngFundZeile.Cells(3)
.Column(4, .ListCount - 1) = rngFundZeile.Cells(4)
.Column(5, .ListCount - 1) = rngFundZeile.Cells(6)
Next
End With
Set rngFund = rngSuchbereich.FindNext(rngFund)
Loop While rngFund.Address strErsterFund
End If
End Sub