nur halbe Daten bei Listbox-Darstellung
03.11.2016 12:12:24
Dennis
ich habe mir eine UF gebastelt, Basis Dafür ist die Datei: https://www.herber.de/bbs/user/77070.xlsm
aus dem Topic "Listbox filtern Combobox" von 2011.
Mein Problem ist, dass ich die Daten soweit alle anpassen konnte und auch alles in das Array geschrieben wird. Die Vergleiche passen auch alle, aber es werden nur 10 der 18 Zeilen in der Listbox angezeigt und ich finde einfach den Fehler nicht :(
Hier mal der Quellcode:
Public chk As Boolean
Sub checkit()
Dim ar(18) 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
Cont99.Clear
For i = 1 To 17
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 17
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
tempStr2 = Cells(i, 1) & "/" & Cells(i, 2) & "/" & Cells(i, 3) & "/" & Cells(i, 4) & "/" & Cells(i, 5) & "/" & Cells(i, 6) & "/" & Cells(i, 7) & "/" & Cells(i, 8) & "/" & Cells(i, 9) & "/" & Cells(i, 10) & "/" & Cells(i, 11) & "/" & Cells(i, 12) & "/" & Cells(i, 13) & "/" & Cells(i, 14) & "/" & Cells(i, 15) & "/" & Cells(i, 16) & "/" & Cells(i, 17) & "/" & Cells(i, 18) & "/"
If tempStr2 Like tempStr1 Then
On Error Resume Next
objMyDic.Add Cells(i, IntC).Value, 0
If Err.Number = 0 And IntC = 1 Then
Cont99.AddItem Cells(i, 1)
Cont99.List(row_, 1) = Cells(i, 2)
Cont99.List(row_, 2) = Cells(i, 3)
Cont99.List(row_, 3) = Cells(i, 4)
Cont99.List(row_, 4) = Cells(i, 5)
Cont99.List(row_, 5) = Cells(i, 6)
Cont99.List(row_, 6) = Cells(i, 7)
Cont99.List(row_, 7) = Cells(i, 8)
Cont99.List(row_, 8) = Cells(i, 9)
Cont99.List(row_, 9) = Cells(i, 10)
Cont99.List(row_, 10) = Cells(i, 11)
Cont99.List(row_, 11) = Cells(i, 12)
Cont99.List(row_, 12) = Cells(i, 13)
Cont99.List(row_, 13) = Cells(i, 14)
Cont99.List(row_, 14) = Cells(i, 15)
Cont99.List(row_, 15) = Cells(i, 16)
Cont99.List(row_, 16) = Cells(i, 17)
Cont99.List(row_, 17) = Cells(i, 18)
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
Die einzelnen Comboboxen werden mit dem alten code angesprochen:
Beispiel:
Private Sub Cont1_Change()
If chk = False Then
chk = True
Call checkit
End If
End Sub
Private Sub CommandButton1_Click()
Dim i As Integer
For i = 1 To 18
Controls("Cont" & i).Value = ""
Next
End Sub
Und CoulumnCount für die LB habe ich auch schon auf 18 gesetzt daran liegt es also auch nicht.
Wäre super wenn ihr mir einen Tipp geben könntet.
Gruß
Dennis