Sucherergebnisse in Listbox richtig sortieren

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Private Sub CommandButton1_Click() 'Suche und Ergebnisse in Listbox Dim rngCell As Range Dim strFirstAddress As String With Worksheets("Kunden").Range("Kunden") 'Bereich im Kunden-Tab ggf. erweitern Me.ListBox1.Clear Set rngCell = .Find(what:=TextBox1, LookIn:=xlValues, lookat:=xlPart, MatchCase:=False) If Not rngCell Is Nothing Then strFirstAddress = rngCell.Address Do With Me.ListBox1 .ColumnCount = 5 .AddItem .List(.ListCount - 1, 0) = Worksheets("Kunden").Cells(rngCell.Row, 1) .List(.ListCount - 1, 1) = Worksheets("Kunden").Cells(rngCell.Row, 2) .List(.ListCount - 1, 2) = Worksheets("Kunden").Cells(rngCell.Row, 3) .List(.ListCount - 1, 3) = Worksheets("Kunden").Cells(rngCell.Row, 4) .List(.ListCount - 1, 4) = Worksheets("Kunden").Cells(rngCell.Row, 5) .ColumnWidths = "2,0cm;2,0cm;2,5cm;1,5cm;1,5cm" End With Set rngCell = .FindNext(rngCell) Loop While Not rngCell Is Nothing And rngCell.Address strFirstAddress Else MsgBox "Kunde nicht gefunden. Alternativ mit * eingeben", 48 End If End With End Sub

Hallo Stefan,
passe das Suchmakro wie folgt an.
LG
Franz

Private Sub CommandButton1_Click() 'Suche und Ergebnisse in Listbox
Dim rngCell As Range
Dim strFirstAddress As String
Dim wksKunde As Worksheet
Dim Zeile As Long
Set wksKunde = Worksheets("Kunden")
With wksKunde.Range("Kunden") 'Bereich im Kunden-Tab ggf. erweitern
Me.ListBox1.Clear
Set rngCell = .Find(what:=TextBox1, LookIn:=xlValues, lookat:=xlPart, MatchCase:=False)
If Not rngCell Is Nothing Then
strFirstAddress = rngCell.Address
Do
Zeile = rngCell.Row
With Me.ListBox1
.ColumnCount = 5
.AddItem
.List(.ListCount - 1, 0) = wksKunde.Cells(Zeile, 1).Value
.List(.ListCount - 1, 1) = wksKunde.Cells(Zeile, 2).Value
.List(.ListCount - 1, 2) = wksKunde.Cells(Zeile, 3).Value
.List(.ListCount - 1, 3) = wksKunde.Cells(Zeile, 4).Value
.List(.ListCount - 1, 4) = wksKunde.Cells(Zeile, 5).Value
.ColumnWidths = "2,0cm;2,0cm;2,5cm;1,5cm;1,5cm"
End With
Set rngCell = .FindNext(rngCell)
Loop While Not rngCell Is Nothing And rngCell.Address  strFirstAddress
Else
MsgBox "Kunde nicht gefunden. Alternativ mit * eingeben", 48
End If
End With
End Sub

Beliebteste Forumthreads (12 Monate)

Sucherergebnisse in Listbox richtig sortieren

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Sucherergebnisse in Listbox richtig sortieren

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread