Inhalt in Listbox finden und markieren

Hallo liebe Excel-User,
nach stundenlanger Suche muss ich jetzt leider mein Problem hier schildern und hoffe dazu dringend auf Eure Hilfe.....
In einem Userform (Userform1) habe ich eine Listbox (ListBox1), in die ich Daten aus einem Tabellenblatt "Kunden" mittels Makro einlese.
Das Tabellenblatt hat 5 Spalten, von denen jedoch nur die Spalten 2 bis 5 in der Listbox angezeigt werden. Die Spalte 1 (die Anrede) ist in der Listbox ausgeblendet. Zudem werden die Spaltenüberschriften aus dem Tabellenblatt "Kunden" ebenfalls in der Listbox mit angezeigt.
Da die Listbox recht lang ist suche ich eine Möglichkeit, mittels eines Textfeldes bestimmte Einträge in der Listbox zu finden.
Ich möchte also, dass bei Eingabe eines Suchbegriffes in eine Textbox (TextBox35) alle Zeilen und Spalten der Listbox nach dem Suchbegriff durchsucht werden. Gebe ich z.B. als Suchbegriff "mann" ein, dann sollen alle Einträge mit "mann" (z.B. Zimmermann, Hoffmann etc.) markiert werden.
Könnte mir jemand einen Tipp geben, wie der VBA-Code auszusehen hat ? Ich bin inzwischen echt hilflos und kenne bestimmt schon alle Suchergebnisse von Google zu diesem Thema.......... ;-(((
Danke für jede Hilfe
Andreas

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub UserForm_Activate() 'INHALT LISTBOX FÜR KUNDEN AUS TABELLENBLATT 'KUNDEN' IMPORTIEREN Worksheets("Kunden").Select a = 1 Do Until Cells(a, 1) = "" a = a + 1 Loop anfang = Cells(1, 1) ende = Cells(a, 1) bereich = Worksheets("Kunden").Range(Cells(2, 1), Cells(a - 1, 5)).Address ListBox1.RowSource = bereich ListBox1.ColumnCount = 5 ListBox1.ColumnWidths = ("0 Pt;220 Pt;200 Pt;170 Pt;115 Pt") end sub

Private Sub TextBox35_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) Dim i As Long, j As Long Dim strLine As String For i = 0 To ListBox1.ListCount - 1 strLine = Empty For j = 0 To ListBox1.ColumnCount - 1 strLine = strLine & ";" & ListBox1.List(i, j) If InStr(strLine, TextBox35.Value) > 0 Then ListBox1.ListIndex = i Exit Sub End If Next j Next End Sub

Private Sub TextBox35_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) Dim i As Long, j As Long Dim strLine As String For i = 0 To ListBox1.ListCount - 1 strLine = Empty For j = 0 To ListBox1.ColumnCount - 1 strLine = strLine & ";" & ListBox1.List(i, j) If InStr(LCase(strLine), LCase(TextBox35.Value)) > 0 Then ListBox1.ListIndex = i Exit Sub End If Next j Next End Sub

Private Sub TextBox35_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) Dim i As Long, j As Long Dim strLine As String For i = 0 To ListBox1.ListCount - 1 strLine = Empty For j = 0 To ListBox1.ColumnCount - 1 strLine = strLine & ";" & ListBox1.List(i, j) If InStr(LCase(strLine), LCase(TextBox35.Value)) > 0 Then ListBox1.Selected(i) = True Else ListBox1.Selected(i) = False End If Next j Next End Sub

Private Sub TextBox35_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) Dim i As Long, j As Long Dim strLine As String, bolFound As Boolean For i = 0 To ListBox1.ListCount - 1 strLine = Empty For j = 0 To ListBox1.ColumnCount - 1 strLine = strLine & ";" & ListBox1.List(i, j) If InStr(LCase(strLine), LCase(TextBox35.Value)) > 0 Then ListBox1.Selected(i) = True If Not bolFound Then ListBox1.ListIndex = i bolFound = True End If Else ListBox1.Selected(i) = False End If Next j Next End Sub

Private Sub TextBox35_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) Dim i As Long, j As Long Dim strLine As String, bolFound As Boolean For i = 0 To ListBox1.ListCount - 1 strLine = Empty For j = 0 To ListBox1.ColumnCount - 1 strLine = strLine & ";" & ListBox1.List(i, j) If InStr(LCase(strLine), LCase(TextBox35.Value)) > 0 Then ListBox1.Selected(i) = True If Not bolFound Then ListBox1.ListIndex = i ListBox1.TopIndex = i - 1 bolFound = True End If Else ListBox1.Selected(i) = False End If Next j Next End Sub

Private Sub TextBox35_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) Dim i As Long, j As Long Dim strLine As String ', bolFound As Boolean ListBox2.Clear For i = 0 To ListBox1.ListCount - 1 strLine = Empty For j = 0 To ListBox1.ColumnCount - 1 strLine = strLine & ";" & ListBox1.List(i, j) Next j If InStr(LCase(strLine), LCase(TextBox35.Value)) > 0 Then ' ListBox1.Selected(i) = True ' If Not bolFound Then ' ListBox1.ListIndex = i ' bolFound = True ' End If With ListBox2 .AddItem ListBox1.List(i, 0) For j = 1 To ListBox1.ColumnCount - 1 .List(.ListCount - 1, j) = ListBox1.List(i, j) Next j End With ' Else ' ListBox1.Selected(i) = False End If Next End Sub

Private Sub TextBox35_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) Dim a As Long, i As Long, j As Long Dim arrData() As Variant, strLine As String a = 1 Do Until Cells(a, 1) = "" a = a + 1 Loop arrData() = Range(Cells(2, 1), Cells(a - 1, 5)).Value ListBox1.RowSource = "" ListBox1.Clear For i = LBound(arrData, 1) To UBound(arrData, 1) strLine = Empty For j = LBound(arrData, 1) To UBound(arrData, 2) strLine = strLine & ";" & arrData(i, j) Next j If InStr(LCase(strLine), LCase(TextBox35.Value)) > 0 Then ListBox1.AddItem (arrData(i, 1)) For j = 1 To UBound(arrData, 2) ListBox1.List(ListBox1.ListCount - 1, j) = arrData(i, j) Next j End If Next i End Sub

Private Sub TextBox35_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) Dim a As Long, i As Long, j As Long, iCounter As Long Dim arrData() As Variant, arrTreffer As Variant Dim strLine As String a = 1 Do Until Cells(a, 1) = "" a = a + 1 Loop arrData() = Range(Cells(2, 1), Cells(a - 1, 5)).Value ListBox1.RowSource = "" ListBox1.Clear ReDim arrTreffer(1 To UBound(arrData, 2), 1 To 1) For i = LBound(arrData, 1) To UBound(arrData, 1) strLine = Empty For j = LBound(arrData, 1) To UBound(arrData, 2) strLine = strLine & ";" & arrData(i, j) Next j If InStr(LCase(strLine), LCase(TextBox35.Value)) > 0 Then iCounter = iCounter + 1 ReDim Preserve arrTreffer(1 To UBound(arrData, 2), 1 To iCounter) For j = 1 To UBound(arrData, 2) arrTreffer(j, iCounter) = arrData(i, j) Next j End If Next i If iCounter = 0 Then Exit Sub ElseIf iCounter = 1 Then ListBox1.AddItem arrTreffer(1, 1) For j = 1 To UBound(arrTreffer, 1) ListBox1.List(0, j - 1) = arrTreffer(j, 1) Next j Else arrTreffer = Application.Transpose(arrTreffer) ListBox1.List = arrTreffer End If End Sub

Private Sub UserForm_Initialize() With Sheets("Kunden") ListBox1.RowSource = .Name & "!" & .Range(.Cells(2, 1), .Cells(.Range("A2").End(xlDown). _ Row, 5)).Address End With ListBox1.ColumnCount = 5 ListBox1.ColumnWidths = ("0 Pt;220 Pt;200 Pt;170 Pt;115 Pt") End Sub Private Sub TextBox35_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) Dim i As Long, j As Long, iCounter As Long Dim arrData() As Variant, arrTreffer As Variant Dim strLine As String With Sheets("Kunden") arrData() = .Range(.Cells(2, 1), .Cells(.Range("A2").End(xlDown).Row, 5)).Value End With ReDim arrTreffer(1 To UBound(arrData, 2), 1 To 1) For i = LBound(arrData, 1) To UBound(arrData, 1) strLine = Empty For j = LBound(arrData, 1) To UBound(arrData, 2) strLine = strLine & ";" & arrData(i, j) Next j If InStr(LCase(strLine), LCase(TextBox35.Value)) > 0 Then iCounter = iCounter + 1 ReDim Preserve arrTreffer(1 To UBound(arrData, 2), 1 To iCounter) For j = 1 To UBound(arrData, 2) arrTreffer(j, iCounter) = arrData(i, j) Next j End If Next i With ListBox1 .RowSource = "" .Clear If iCounter = 0 Then Exit Sub ElseIf iCounter = 1 Then .AddItem arrTreffer(1, 1) For j = 1 To UBound(arrTreffer, 1) .List(0, j - 1) = arrTreffer(j, 1) Next j Else arrTreffer = Application.Transpose(arrTreffer) .List = arrTreffer End If End With End Sub

Private Sub TextBox35_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) Dim i As Long, j As Long, iCounter As Long Dim arrData() As Variant, arrTreffer As Variant Dim strLine As String With Sheets("Kunden") arrData() = .Range(.Cells(2, 1), .Cells(.Range("A2").End(xlDown).Row, 5)).Value End With ReDim arrTreffer(1 To UBound(arrData, 2), 1 To 1) For i = LBound(arrData, 1) To UBound(arrData, 1) strLine = Empty For j = LBound(arrData, 1) To UBound(arrData, 2) strLine = strLine & ";" & arrData(i, j) Next j If InStr(LCase(strLine), LCase(TextBox35.Value)) > 0 Then iCounter = iCounter + 1 ReDim Preserve arrTreffer(1 To UBound(arrData, 2), 1 To iCounter) For j = 1 To UBound(arrData, 2) arrTreffer(j, iCounter) = arrData(i, j) Next j End If Next i With ListBox1 .RowSource = "" .Clear If iCounter = 1 Then .AddItem arrTreffer(1, 1) For j = 1 To UBound(arrTreffer, 1) .List(0, j - 1) = arrTreffer(j, 1) Next j ElseIf iCounter > 1 Then arrTreffer = Application.Transpose(arrTreffer) .List = arrTreffer End If .AddItem 0, 0 For j = 0 To 4 .List(0, j) = Sheets("Kunden").Cells(2, j + 1) Next .TopIndex = 0 End With End Sub

Hallo Andreas,
kann es sein, dass du die ColumnHeads-Eigenschaft der ListBox1 auf "True" gestellt hast? Leider funktioniert das bei Excel nur, wenn die ListBox über RowSource an die Tabelle gebunden ist. Mit unserer "Filterfunktion" ist das leider NICHT möglich (bzw. nur beim Starten des UserForms). Bitte setze die ColumnHeads-Eigenschaft auf "False". Mit folgendem Code bleibt in der ersten Zeile immer die Überschrift stehen, aber leider nicht hervorgehoben. Es geht wirklich nicht anders!

Private Sub TextBox35_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Dim i As Long, j As Long, iCounter As Long
Dim arrData() As Variant, arrTreffer As Variant
Dim strLine As String
With Sheets("Kunden")
arrData() = .Range(.Cells(2, 1), .Cells(.Range("A2").End(xlDown).Row, 5)).Value
End With
ReDim arrTreffer(1 To UBound(arrData, 2), 1 To 1)
For i = LBound(arrData, 1) To UBound(arrData, 1)
strLine = Empty
For j = LBound(arrData, 1) To UBound(arrData, 2)
strLine = strLine & ";" & arrData(i, j)
Next j
If InStr(LCase(strLine), LCase(TextBox35.Value)) > 0 Then
iCounter = iCounter + 1
ReDim Preserve arrTreffer(1 To UBound(arrData, 2), 1 To iCounter)
For j = 1 To UBound(arrData, 2)
arrTreffer(j, iCounter) = arrData(i, j)
Next j
End If
Next i
With ListBox1
.RowSource = ""
.Clear
If iCounter = 1 Then
.AddItem arrTreffer(1, 1)
For j = 1 To UBound(arrTreffer, 1)
.List(0, j - 1) = arrTreffer(j, 1)
Next j
ElseIf iCounter > 1 Then
arrTreffer = Application.Transpose(arrTreffer)
.List = arrTreffer
End If
.AddItem 0, 0
For j = 0 To 4
.List(0, j) = Sheets("Kunden").Cells(1, j + 1)
Next
.TopIndex = 0
End With
End Sub
Private Sub UserForm_Initialize()
With Sheets("Kunden")
ListBox1.RowSource = .Name & "!" & .Range(.Cells(1, 1), .Cells(.Range("A2").End(xlDown). _
Row, 5)).Address
End With
End Sub

Ich hoffe, dass jetzt alles zu deiner Zufriedenheit klappt!
Viele Grüße
Martin

Beliebteste Forumthreads (12 Monate)

Inhalt in Listbox finden und markieren

24
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Inhalt in Listbox finden und markieren

24 Beiträge zum Forumthread Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

24
Beiträge zum Forumthread

Beiträge zu diesem Forumthread