nachdem ich bis heute nur mitleser war, bin ich jetzt endlich Mit-Glied :)
Über mein Thema gibt es schon einen Thread, den ich mal erneuern möchte.
https://www.herber.de/forum/archiv/1232to1236/1234318_Listbox_filtern_Combobox.html#bottom
Ich benutze die Datei von "Mäxl" https://www.herber.de/bbs/user/77070.xlsm
und habe da meine Probleme den code für mich anzupassen und hoffe auf eure hilfe.
1. möchte ich die listbox auf mehrere Spalten erweitern
2. möchte ich mehrere auswahlcombos anlegen
Sub checkit()
Dim ar(4) As Variant, objMyDic As Object, i As Long, tempStr1 As String, tempStr2 As String, _
IntC As Integer, row_ As Integer
Set objMyDic = CreateObject("Scripting.Dictionary")
If chk = True Then
Cont4.Clear
For i = 1 To 5
If Controls("Cont" & i).Value = "" Then ar(i - 1) = "*" Else ar(i - 1) = Controls("Cont" _
& i).Value
tempStr1 = tempStr1 & ar(i - 1) & "/"
Controls("Cont" & i).Clear
Controls("Cont" & i) = IIf(ar(i - 1) = "*", "", ar(i - 1))
Next
For IntC = 1 To 5
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
tempStr2 = Cells(i, 1) & "/" & Cells(i, 2) & "/" & Cells(i, 3) & "/"
If tempStr2 Like tempStr1 Then
On Error Resume Next
objMyDic.Add Cells(i, IntC).Value, 0
If Err.Number = 0 And IntC = 1 Then
Cont4.AddItem Cells(i, 1)
Cont4.List(row_, 1) = Format(Cells(i, 2), "0%")
Cont4.List(row_, 2) = Cells(i, 3)
Cont4.List(row_, 3) = Cells(i, 4)
Cont4.List(row_, 4) = Cells(i, 5)
row_ = row_ + 1
End If
On Error GoTo 0
End If
Next
Controls("Cont" & IntC).List = objMyDic.keys
objMyDic.RemoveAll
Next
End If
Set objMyDic = Nothing
chk = False
End Sub
mein versuch hat leider keinen erfolg gezeigtlg tom