Public Function QuickSort_ArrayColumn _
            (ByRef Array_To_Sort As Variant, _
            ByVal SortColumn_Index As Long, _
            Optional ByVal FirstRow_ToSort As Long = -10000000, _
            Optional ByVal LastRow_ToSort As Long = -100000000, _
            Optional ByVal SortAscending As Boolean = True, _
            Optional ByRef ErrorMessage As String) As Boolean
 
            'Quicksort: Array nach 1. Dimension (Zeilen) gemäß einem
            'Index in 2. Dimension (Spalte) sortieren
            'optional: nur einen Abschnitt (FirstRow-,LastRow_ToSort) sortieren
            'optional: ansteigend oder fallend sortieren
            'optional Fehlermeldung zurückgeben
 
            Err.Clear
            On Error GoTo errorexit
 
            If VarType(Array_To_Sort) < vbArray Then
                QuickSort_ArrayColumn = "Kein Array als Parameter übergeben"
                Exit Function
            End If
 
            If SortColumn_Index < LBound(Array_To_Sort, 2) Or _
               SortColumn_Index > UBound(Array_To_Sort, 2) Then
                ErrorMessage = "Spalten-Index ausserhalb Array-Grenzen"
                Exit Function
            End If
 
            'Zufallszahlen für Aufteilungsindex initialisieren
            Randomize Timer
 
            'Arraygrenzen anfragen
            Dim FirstCol_Array As Long: FirstCol_Array = LBound(Array_To_Sort, _
              2)
            Dim LastCol_Array As Long: LastCol_Array = UBound(Array_To_Sort, 2)
            Dim FirstRow_Array As Long: FirstRow_Array = LBound(Array_To_Sort, _
              1)
            Dim LastRow_Array As Long: LastRow_Array = UBound(Array_To_Sort, 1)
 
            ' Wird die Bereichsgrenze nicht angegeben,
            ' werden alle Arrayzeilen anhand der Spalte sortiert
            If FirstRow_ToSort < FirstRow_Array Then FirstRow_ToSort = _
              FirstRow_Array
            If LastRow_ToSort < FirstRow_ToSort Or _
            LastRow_ToSort > LastRow_Array Then LastRow_ToSort = LastRow_Array
 
            If FirstRow_ToSort > LastRow_ToSort Then
                ErrorMessage = "Ungeeignete Bereichsangabe"
                Exit Function
            End If
 
            Dim i, j As Long: i = FirstRow_ToSort: j = LastRow_ToSort
            Dim x_part As Variant 'Aufteilungswert
            'Array-Element am zufällig ausgewählten Aufteilungsindex lesen
            x_part = _
            Array_To_Sort(RandomLong(FirstRow_ToSort, LastRow_ToSort), _
            SortColumn_Index)
 
            ' Array aufteilen
            Do
                If SortAscending Then
                    While Array_To_Sort(i, SortColumn_Index) < x_part
                        i = i + 1
                    Wend
                    While Array_To_Sort(j, SortColumn_Index) > x_part
                        j = j - 1
                    Wend
                Else
                    While Array_To_Sort(i, SortColumn_Index) > x_part
                        i = i + 1
                    Wend
                    While Array_To_Sort(j, SortColumn_Index) < x_part
                        j = j - 1
                    Wend
                End If
 
                If (i <= j) Then
                    ' Wertepaare miteinander tauschen
                    Call SwapArrayRow(Array_To_Sort, i, j)
                    i = i + 1: j = j - 1
                End If
            Loop Until (i > j)
 
            'rekursiver Quicksort
            If (FirstRow_ToSort < j) Then
                If Not QuickSort_ArrayColumn(Array_To_Sort, _
                SortColumn_Index, FirstRow_ToSort, j, SortAscending, _
                ErrorMessage) Then
                    Exit Function
                End If
            End If
            If (i < LastRow_ToSort) Then
                If Not QuickSort_ArrayColumn(Array_To_Sort, _
                    SortColumn_Index, i, LastRow_ToSort, SortAscending, _
                    ErrorMessage) Then
                   Exit Function
                End If
            End If
 
            'Korrektes Ende der Rekursiven Funktion
            ErrorMessage = "": QuickSort_ArrayColumn = True: Exit Function
 
errorexit:
            ErrorMessage = Err.Description
        End Function