'Sortierfunktion für Spalten einer Listbox
'columindex: Spaltenindex ab 1
'columntype: Datentyp Sortierspalte 0=String, 1=Double, 2=Date
'ascending:  Sortier-Richtung
Public Sub SortListbox(ByVal lbo As Msforms.ListBox, _
                       ByVal columnindex As Integer, _
                       ByVal columntype As Integer, _
              Optional ByVal ascending As Boolean = True)
 
   Dim entries() As Variant, i As Integer, k As Integer
   With ListBox1
      ReDim entries(.ListCount - 1, .ColumnCount - 1)
      entries = .Column
      Call QuickSortArray(entries, _
      columnindex, columntype, 0, .ListCount - 1, ascending)
      .Column = entries
   End With
End Sub
 
' vSort: 2-dimensionales Array
' columnindex: Spalte, nach der sortiert werden soll (1, 2, 3, ...)
' columntype: Datentyp Sortierspalte 0=String, 1=Double, 2=Date
' !!! Array-Dimensionen werden als Spalte * Zeile erwartet !!!
Public Sub QuickSortArray(vSort As Variant, _
  ByVal columnindex As Integer, ByVal columntype As Integer, _
  ByVal lngStart As Long, ByVal lngEnd As Long, _
  Optional ByVal ascending As Boolean = True)
 
  Dim i As Long, j As Long
  Dim h As Variant, x As Variant
  Dim u As Long, lb_dim As Long, ub_dim As Long
 
  ' Anzahl Elemente pro Datenzeile
  lb_dim = LBound(vSort, 1)
  ub_dim = UBound(vSort, 1)
 
  i = lngStart: j = lngEnd
  x = vSort(columnindex - 1, (lngStart + lngEnd) / 2)
 
  ' Array aufteilen
  Do
 
    While CompareEntries(columntype, ascending, vSort(columnindex - 1, i), x) = _
      -1
      i = i + 1
    Wend
    While CompareEntries(columntype, ascending, vSort(columnindex - 1, j), x) = _
      1
      j = j - 1
    Wend
 
    If (i <= j) Then
      ' Wertepaare miteinander tauschen
      For u = lb_dim To ub_dim
        h = vSort(u, i)
        vSort(u, i) = vSort(u, j)
        vSort(u, j) = h
      Next u
      i = i + 1: j = j - 1
    End If
  Loop Until (i > j)
 
  If (lngStart < j) Then _
     QuickSortArray vSort, columnindex, columntype, lngStart, j, ascending
  If (i < lngEnd) Then _
     QuickSortArray vSort, columnindex, columntype, i, lngEnd, ascending
 
End Sub
 
Public Function CompareEntries(ByVal columntype As Integer, _
          ByVal ascending As Boolean, _
          ByVal e1 As Variant, ByVal e2 As Variant) As Integer
 
          Dim bigger%, lower%
          If ascending Then
             bigger = 1: lower = -1
          Else
             bigger = -1: lower = 1
          End If
 
          CompareEntries = 0
 
          If columntype = 0 Then
             If CStr(e1) > CStr(e2) Then
                CompareEntries = bigger
             ElseIf CStr(e1) < CStr(e2) Then
                CompareEntries = lower
             End If
          ElseIf columntype = 1 Then
             If CDbl(e1) > CDbl(e2) Then
                CompareEntries = bigger
             ElseIf CDbl(e1) < CDbl(e2) Then
                CompareEntries = lower
             End If
          ElseIf columntype = 2 Then
             If CDate(e1) > CDate(e2) Then
                CompareEntries = bigger
             ElseIf CDate(e1) < CDate(e2) Then
                CompareEntries = lower
             End If
          Else
             If e1 > e2 Then
                CompareEntries = bigger
             ElseIf e1 < e2 Then
                CompareEntries = lower
             End If
          End If
End Function