' vSort -> mehrdimensionales Array
' index -> Spalte, nach der sortiert werden soll (1, 2, 3, ...)
Public Sub QuickSortMultiDim(vSort As Variant, _
  Optional ByVal index As Integer = 1, _
  Optional ByVal lngStart As Variant, _
  Optional ByVal lngEnd As Variant)
 
  ' Wird die Bereichsgrenze nicht angegeben,
  ' so wird das gesamte Array sortiert
 
  If IsMissing(lngStart) Then lngStart = LBound(vSort)
  If IsMissing(lngEnd) Then lngEnd = UBound(vSort)
 
  Dim i As Long
  Dim j As Long
  Dim h As Variant
  Dim x As Variant
  Dim u As Long
  Dim lb_dim As Integer
  Dim ub_dim As Integer
 
  ' Anzahl Elemente pro Datenzeile
  lb_dim = LBound(vSort, index)
  ub_dim = UBound(vSort, index)
 
  i = lngStart: j = lngEnd
  x = vSort((lngStart + lngEnd) / 2, index - 1)
 
  ' Array aufteilen
  Do
 
    While (vSort(i, index - 1) < x): i = i + 1: Wend
    While (vSort(j, index - 1) > x): 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)
 
  ' Rekursion (Funktion ruft sich selbst auf)
  If (lngStart < j) Then QuickSortMultiDim vSort, index, lngStart, j
  If (i < lngEnd) Then QuickSortMultiDim vSort, index, i, lngEnd
End Sub

QuickSortMultiDim arDaten, 2

Dim arDaten(0 To 2, 0 To 6) As Variant
AddToArray arDaten, 0, 281096, 12, 1494, 2456, 123, 234, "test1"
AddToArray arDaten, 1, 281096, 1, 1456, 3213, 123, 345, "test"
AddToArray arDaten, 2, 281096, 16, 1234, 3247, 123, 45, "test2"
 
QuickSortMultiDim arDaten, 2
 
Dim i As Long
For i = 0 To 2
  Debug.Print arDaten(i, 6), arDaten(i, 1)
Next i

Private Function AddToArray(ByRef arDaten As Variant, _
  ByVal index As Long, _
  ParamArray values() As Variant)
 
  Dim i As Long
 
  For i = 0 To UBound(values)
    arDaten(index, i) = values(i)
  Next i
End Function

_________________________
Professionelle Entwicklerkomponenten
www.tools4vb.de