Suche filtern
06.04.2018 19:20:12
Dietmar
undzwar habe ich ein Code gefunden was eigentlich super läuft aber ein kleinen Mängel hat, bzw etwas verbessert werden muss. Da ich die genügenden VBA Kenntnisse nicht besitze würde ich mich freuen wenn ihr mir helfen würdet.
zum Beispiel:
bei mir ist die Spalte A "Ort", Und TextBox 1 ist für Spalte A zugeordnet.
Wenn ich in Textbox 1 "Berlin" ausschreibe zeigt er mir es in Listbox an so wie ich es haben möchte. Aber mein Problem ist es, Solange ich in Textbox1 "B" reinschreibe soll er mir alles aufliste wo "b" auftaucht, bei diesem code muss ich alles ausschreiben, und das möchte ich nicht. Wenn ich "BE" reinschreibe soll er mir :
BErlin
württemBErg
winterBErg
NürnBErg
auflisten.
Public Sub filtern()
Dim s As Variant, FA As String, c As Control, Lz As Long, erste_TB As Control
Me.ListBox1.Clear
Lz = Cells(Rows.Count, 1).End(xlUp).Row
If Lz "" Then
Set erste_TB = c
GoTo Weiter1
End If
End If
Next c
For s = 2 To Lz
With Me.ListBox1
.AddItem
.List(.ListCount - 1, 0) = Range("A" & s & "")
.List(.ListCount - 1, 1) = Range("B" & s & "")
.List(.ListCount - 1, 2) = Range("C" & s & "")
.List(.ListCount - 1, 3) = Range("D" & s & "")
.List(.ListCount - 1, 4) = Range("E" & s & "")
.List(.ListCount - 1, 5) = Range("F" & s & "")
.List(.ListCount - 1, 6) = Range("G" & s & "")
.List(.ListCount - 1, 7) = Range("H" & s & "")
.List(.ListCount - 1, 8) = Range("I" & s & "")
.List(.ListCount - 1, 9) = Range("J" & s & "")
End With
Next s
Exit Sub
Weiter1:
With Range(erste_TB.Tag & "2:" & erste_TB.Tag & Lz & "")
Set s = .Find(c, LookIn:=xlValues, lookat:=xlWhole)
If Not s Is Nothing Then
FA = s.Address
Do
For Each c In Me.Controls
If TypeName(c) = "TextBox" Then
If c.Name erste_TB.Name And Trim(c.Text) "" Then
If Not LCase(Range(c.Tag & s.Row)) Like LCase(c) Then GoTo Weiter2
End If
End If
Next c
With Me.ListBox1
.AddItem
.List(.ListCount - 1, 0) = Range("A" & s.Row & "")
.List(.ListCount - 1, 1) = Range("B" & s.Row & "")
.List(.ListCount - 1, 2) = Range("C" & s.Row & "")
.List(.ListCount - 1, 3) = Range("D" & s.Row & "")
.List(.ListCount - 1, 4) = Range("E" & s.Row & "")
.List(.ListCount - 1, 5) = Range("F" & s.Row & "")
.List(.ListCount - 1, 6) = Range("G" & s.Row & "")
.List(.ListCount - 1, 7) = Range("H" & s.Row & "")
.List(.ListCount - 1, 8) = Range("I" & s.Row & "")
.List(.ListCount - 1, 9) = Range("J" & s.Row & "")
End With
Weiter2:
Set s = .FindNext(s)
Loop While Not s Is Nothing And s.Address FA
End If
End With
End Sub