Werte aus Userform (multiselect) Listbox und Textbox in Tabelle suchen und übereinstimmende Zeilen in Tabellenblatt kopieren
02.12.2019 12:05:23
CoreoG
Brauche dringend Hilfe!
Ich habe ein Userform mit einem Textfeld und einer Listbox (multiselect) erstellt. Jetzt möchte ich gerne die selektierten Werte mittels Schleife suchen und bei Übereinstimmung die entsprechenden Zeilen kopieren und in einem neuen Tabellenblatt einfügen.
Es gibt Spaltenüberschriften, sodass nur in den Spalten gesucht werden müsste.
In der Spalte "Klasse" soll der Begriff "C" (verknüpft mit Textbox) gesucht werden und in der Spalte "Gruppe" (verknüpft mit Listbox - multiselect möglich) sollen mehrere Begriffe gesucht werden z.B. "gelb" , "grün" , "blau", "rot". Wenn in "Gruppe" keine Auswahl getroffen wurde, dann sollen alle 10 Felder als ausgewählt angenommen werden.
Die Zeilen, die z.B. "G" und "gelb" und "grün" enthalten, sollen in eine weitere Tabelle kopiert werden (+ eine zusätzliche Spalte "Name" mit zugehörigem Inhalt).
So sieht mein Code aus, leider macht er noch nicht, was ich will. Kann mir jemand Tipps geben, _
was ich falsch mache?
Sub Filter()
Const Addr1 = "B2"
Const ColNo = 3
Dim Tab1 As Object, Tab2 As Object
'Dim Klasse As Range, Gruppe As Range, Name As Range
Dim sKlasse As Range, sGruppe As Range
Dim lrow As Integer
Dim wks_Liste As Worksheet
Dim wks_Resultate As Worksheet
Set wks_Liste = Worksheets(wsn_Liste)
wks_Liste.Activate
' Klasse = Worksheets(wsn_Liste).UsedRange.Find(What:=Klasse, LookIn:=xlValues, lookat:= _
_
_
_
_
' xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True).Column
' Gruppe = Worksheets(wsn_Liste).UsedRange.Find(What:=Gruppe, LookIn:=xlValues, lookat:= _
_
_
_
_
' xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True).Column
' Name = Worksheets(wsn_Liste).UsedRange.Find(What:=Name, LookIn:=xlValues, lookat:= _
' xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True).Column
Set sKlasse = Worksheets(wsn_Liste).UsedRange.Find(What:=txbKlasse.Text, LookIn:=xlValues, _
_
_
_
lookat:=_
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True)
Set sGruppe = Worksheets(wsn_Liste).UsedRange.Find(What:=lboGruppe.List(i), LookIn:= _
xlValues, lookat:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True)
Application.ScreenUpdating = False
'Schleife zum durchsuchen von Tabelle1
For Each i In Range(Addr1, Range(Addr1).End(xlDown))
If Not sKlasse Is Nothing Then
ElseIf Not sGruppe Is Nothing Then
Worksheets(wsn_Liste).Row.Copy Worksheets(wsn_Resultate).Rows(lrow)
MsgBox "You have selected: " & lboGruppe.List(i)
With Worksheets(wsn_Liste)
lrow = .Cells(Rows.Count, 1).End(xlUp).Row
If lrow = 1 Then lrow = 2 Else lrow = lrow + 3
i.EntireRow.Copy Worksheets(wsn_Resultate).Rows(lrow)
End With
ElseIf sGruppe Is Nothing Then
MsgBox "Information: You have not choosen any group, so all groups will be _
selected."
lboGruppe.Select True
End If
Next i
Application.ScreenUpdating = True
End Sub