ListBox Filtern + sortieren

Option Explicit
Private worksheet_ As Worksheet
Private Agent As New VBAgent
Private ID_List As Variant
Sub a()
Set worksheet_ = ThisWorkbook.Sheets("Depot")
bySize 3
End Sub
Private Sub bySize(ByVal col_ As Long)
Dim tmp() As String, i As Long
Dim dict As New Dictionary
Dim rng As Range
Dim t As String
Dim var_ As Variant
Dim varItem As Variant
Dim a() As String
With worksheet_
Set rng = .Range(.Cells(2, 1), .Cells(LastRow(col_), 6))
For i = 2 To rng.Rows.Count
tmp = Split(rng.Cells(i, col_).Value, ";")
If Not dict.Exists(tmp(1)) Then
dict.Add tmp(1), rng.Cells(i, 1).Value & ";" & tmp(0) & ";" & tmp(2)
Else
t = dict(tmp(1)) & "\" & rng.Cells(i, 1).Value & ";" & tmp(0) & ";" & tmp(2)
dict(tmp(1)) = t
End If
Next i
End With
Agent.SortDictionary dict, True
For Each var_ In dict.Keys
a = Split(dict(var_), "\")
For Each varItem In a
tmp = Split(varItem, ";")
With frm_IO.ListBox1
.AddItem tmp(0)
.List(.ListCount - 1, 1) = tmp(1)
.List(.ListCount - 1, 2) = tmp(2)
End With
Next varItem
Next var_
End Sub
Private Function LastRow(ByVal col_ As Long) As Long
LastRow = worksheet_.Cells(worksheet_.Rows.Count, col_).End(xlUp).Row
End Function

Public Sub SortDictionary(dict As Scripting.Dictionary, _
SortByKey As Boolean, _
Optional Descending As Boolean = False, _
Optional CompareMode As VbCompareMethod = vbTextCompare)
' SortDictionary
' This sorts a Dictionary object. If SortByKey is False, the
' the sort is done based on the Items of the Dictionary, and
' these items must be simple data types. They may not be
' Object, Arrays, or User-Defined Types. If SortByKey is True,
' the Dictionary is sorted by Key value, and the Items in the
' Dictionary may be Object as well as simple variables.
' If sort by key is True, all element of the Dictionary
' must have a non-blank Key value. If Key is vbNullString
' the procedure will terminate.
' By defualt, sorting is done in Ascending order. You can
' sort by Descending order by setting the Descending parameter
' to True.
' By default, text comparisons are done case-INSENSITIVE (e.g.,
' "a" = "A"). To use case-SENSITIVE comparisons (e.g., "a"  "A")
' set CompareMode to vbBinaryCompare.
' Note: This procedure requires the
' QSortInPlace function, which is described and available for
' download at www.cpearson.com/excel/qsort.htm .
Dim Ndx As Long
Dim KeyValue As String
Dim ItemValue As Variant
Dim Arr() As Variant
Dim KeyArr() As String
Dim VTypes() As VbVarType
Dim V As Variant
Dim SplitArr As Variant
Dim TempDict As Scripting.Dictionary
' Ensure Dict is not Nothing.
If dict Is Nothing Then
Exit Sub
End If
' If the number of elements
' in Dict is 0 or 1, no
' sorting is required.
If (dict.Count = 0) Or (dict.Count = 1) Then
Exit Sub
End If
' Create a new TempDict.
Set TempDict = New Scripting.Dictionary
If SortByKey = True Then
' We're sorting by key. Redim the Arr
' to the number of elements in the
' Dict object, and load that array
' with the key names.
ReDim Arr(0 To dict.Count - 1)
For Ndx = 0 To dict.Count - 1
Arr(Ndx) = dict.Keys(Ndx)
Next Ndx
' Sort the key names.
QSortInPlace InputArray:=Arr, LB:=-1, UB:=-1, Descending:=Descending, CompareMode:= _
CompareMode
' Load TempDict. The key value come from
' our sorted array of keys Arr, and the
' Item comes from the original Dict object.
For Ndx = 0 To dict.Count - 1
KeyValue = Arr(Ndx)
TempDict.Add Key:=KeyValue, Item:=dict.Item(KeyValue)
Next Ndx
' Set the passed in Dict object
' to our TempDict object.
Set dict = TempDict
' This is the end of processing.
Else
' Here, we're sorting by items. The Items must
' be simple data types. They may NOT be Objects,
' arrays, or UserDefineTypes.
' First, ReDim Arr and VTypes to the number
' of elements in the Dict object. Arr will
' hold a string containing
'   Item & vbNullChar & Key
' This keeps the association between the
' item and its key.
ReDim Arr(0 To dict.Count - 1)
ReDim VTypes(0 To dict.Count - 1)
For Ndx = 0 To dict.Count - 1
If (IsObject(dict.Items(Ndx)) = True) Or _
(IsArray(dict.Items(Ndx)) = True) Or _
VarType(dict.Items(Ndx)) = vbUserDefinedType Then
Debug.Print "***** ITEM IN DICTIONARY WAS OBJECT OR ARRAY OR UDT"
Exit Sub
End If
' Here, we create a string containing
'       Item & vbNullChar & Key
' This preserves the associate between an item and its
' key. Store the VarType of the Item in the VTypes
' array. We'll use these values later to convert
' back to the proper data type for Item.
Arr(Ndx) = dict.Items(Ndx) & vbNullChar & dict.Keys(Ndx)
VTypes(Ndx) = VarType(dict.Items(Ndx))
Next Ndx
' Sort the array that contains the
' items of the Dictionary along
' with their associated keys
QSortInPlace InputArray:=Arr, LB:=-1, UB:=-1, Descending:=Descending, CompareMode:= _
vbTextCompare
For Ndx = LBound(Arr) To UBound(Arr)
' Loop trhogh the array of sorted
' Items, Split based on vbNullChar
' to get the Key from the element
' of the array Arr.
SplitArr = Split(Arr(Ndx), vbNullChar)
' It may have been possible that item in
' the dictionary contains a vbNullChar.
' Therefore, use UBound to get the
' key value, which will necessarily
' be the last item of SplitArr.
' Then Redim Preserve SplitArr
' to UBound - 1 to get rid of the
' Key element, and use Join
' to reassemble to original value
' of the Item.
KeyValue = SplitArr(UBound(SplitArr))
ReDim Preserve SplitArr(LBound(SplitArr) To UBound(SplitArr) - 1)
ItemValue = Join(SplitArr, vbNullChar)
' Join will set ItemValue to a string
' regardless of what the original
' data type was. Test the VTypes(Ndx)
' value to convert ItemValue back to
' the proper data type.
Select Case VTypes(Ndx)
Case vbBoolean
ItemValue = CBool(ItemValue)
Case vbByte
ItemValue = CByte(ItemValue)
Case vbCurrency
ItemValue = CCur(ItemValue)
Case vbDate
ItemValue = CDate(ItemValue)
Case vbDecimal
ItemValue = CDec(ItemValue)
Case vbDouble
ItemValue = CDbl(ItemValue)
Case vbInteger
ItemValue = CInt(ItemValue)
Case vbLong
ItemValue = CLng(ItemValue)
Case vbSingle
ItemValue = CSng(ItemValue)
Case vbString
ItemValue = CStr(ItemValue)
Case Else
ItemValue = ItemValue
End Select
' Finally, add the Item and Key to
' our TempDict dictionary.
TempDict.Add Key:=KeyValue, Item:=ItemValue
Next Ndx
End If
' Set the passed in Dict object
' to our TempDict object.
Set dict = TempDict
End Sub