'Sortierfunktion für Spalten einer Listbox
'columindex: Spaltenindex ab 1
'columntype: Datentyp Sortierspalte 0=string, 1=Double, 2=Date
Public Sub SortListbox(ByVal lbo As Msforms.ListBox, _
                       ByVal columnindex As Integer, _
                       ByVal columntype As Integer)
 
   Dim entries() As Variant
   With ListBox1
 
      ReDim entries(.ListCount - 1, .ColumnCount - 1)
      For i = 0 To .ListCount - 1
         For k = 0 To .ColumnCount - 1
            entries(i, k) = .List(i, k)
         Next k
      Next i
 
      Call QuickSortArray(entries, columnindex, columntype, _
                          0, .ListCount - 1)
 
      For i = 0 To .ListCount - 1
         For k = 0 To .ColumnCount - 1
           .List(i, k) = entries(i, k)
         Next k
      Next i
 
   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
Public Sub QuickSortArray(vSort As Variant, _
  ByVal columnindex As Integer, ByVal columntype As Integer, _
  ByVal lngStart As Long, ByVal lngEnd As Long)
 
  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, 2)
  ub_dim = UBound(vSort, 2)
 
  i = lngStart: j = lngEnd
  x = vSort((lngStart + lngEnd) / 2, columnindex - 1)
 
  ' Array aufteilen
  Do
 
    While CompareEntries(columntype, vSort(i, columnindex - 1), x) = -1
      i = i + 1
    Wend
    While CompareEntries(columntype, vSort(j, columnindex - 1), x) = 1
      j = j - 1
    Wend
 
    If (i <= j) Then
      ' Wertepaare miteinander tauschen
      For u = lb_dim To ub_dim
        h = vSort(i, u)
        vSort(i, u) = vSort(j, u)
        vSort(j, u) = 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
  If (i < lngEnd) Then _
     QuickSortArray vSort, columnindex, columntype, i, lngEnd
 
End Sub
 
Public Function CompareEntries(ByVal columntype As Integer, _
          ByVal e1 As Variant, ByVal e2 As Variant) As Integer
 
          If columntype = 0 Then
             If CStr(e1) > CStr(e2) Then
                CompareEntries = 1
             ElseIf CStr(e1) < CStr(e2) Then
                CompareEntries = -1
             Else
                CompareEntries = 0
             End If
          ElseIf columntype = 1 Then
             If CDbl(e1) > CDbl(e2) Then
                CompareEntries = 1
             ElseIf CDbl(e1) < CDbl(e2) Then
                CompareEntries = -1
             Else
                CompareEntries = 0
             End If
          Else
             If CDate(e1) > CDate(e2) Then
                CompareEntries = 1
             ElseIf CDate(e1) < CDate(e2) Then
                CompareEntries = -1
             Else
                CompareEntries = 0
             End If
          End If
End Function