Listbox

Private Sub UserForm_Initialize()
Dim objCbx As Object, arrCbx, i As Long
Set objCbx = CreateObject("Scripting.dictionary")
blnInit = True
With Me.ListBox2
.ColumnCount = 4
.ColumnWidths = "1cm;0cm;0cm;6cm"
End With
With Sheets("Stammdaten")
arrCbx = .Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp))
ListBox2.List = .Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp)).Resize(, 4).Value
End With
For i = 1 To UBound(arrCbx)
objCbx(arrCbx(i, 1)) = 0
Next
ComboBox3.List = objCbx.keys
blnInit = False
End Sub

Private Sub ComboBox3_Change()
If Not blnInit Then
With ListBox2
.Clear
.List = fncListe(ComboBox3.Value)
End With
End If
End Sub

Private Function fncListe(sMatch As String)
Dim objListe As Object, oListe, arrListe, arrTmp()
Dim i As Long, j As Integer, n As Integer
Set objListe = CreateObject("Scripting.dictionary")
With Sheets("Stammdaten")
arrListe = .Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp)).Resize(, 4)
End With
If sMatch = "" Then
arrTmp = arrListe
Else
For i = 1 To UBound(arrListe)
If arrListe(i, 1) = sMatch Then
objListe(i) = Array( _
"", _
arrListe(i, 1), _
arrListe(i, 2), _
arrListe(i, 3), _
arrListe(i, 4))
End If
Next i
If objListe.Count Then
ReDim arrTmp(1 To objListe.Count, 1 To 4)
For Each oListe In objListe
n = n + 1
For j = 1 To 4
arrTmp(n, j) = objListe(oListe)(j)
Next
Next
End If
End If
fncListe = arrTmp
Set objListe = Nothing
End Function