Private Sub RecordsetSort(ByRef SortArray() As Variant)
    Dim RS As New ADOR.Recordset
    Dim k As Long
    Dim lb As Long
    Dim ub As Long

    lb = LBound(SortArray)
    ub = UBound(SortArray)
    RS.Fields.Append "ArrValue", adChar,  35 , adFldIsNullable
    RS.Open
    For k = lb To ub
        RS.AddNew
        RS!ArrValue = CStr(SortArray(k))
        RS.Update
    Next k
    RS.Sort = "ArrValue"
    Erase SortArray
    ReDim SortArray(lb To ub) As Variant
    RS.MoveFirst
    For k = lb To ub
        SortArray(k) = RS!ArrValue
        RS.MoveNext
    Next k
    RS.Close
End Sub

Sub test()
Dim x() As Variant
ReDim x( 1  To  10 ) As Variant
For i =  1  To  10 
    x(i) = i
    Debug.Print x(i)
Next i

Call RecordsetSort(x)

For i =  1  To  10 
    Debug.Print x(i)
Next i
End Sub

Private Sub RecordsetSort(ByRef SortArray() As Variant)
    Dim RS As New ADOR.Recordset
    Dim k As Long

    RS.Fields.Append "ArrValue", adChar,  35 , adFldIsNullable
    RS.Fields.Append "Ind", adInteger
    RS.Open
    For k = LBound(SortArray) To UBound(SortArray)
        RS.AddNew
        RS!ArrValue = CStr(SortArray(k))
        RS!ind = k
        RS.Update
    Next k
    RS.Sort = "ArrValue"
    RS.MoveFirst
    For k = LBound(SortArray) To UBound(SortArray)
        SortArray(k) = RS!ind
        RS.MoveNext
    Next k
    RS.Close
End Sub

Sub test()
Dim x() As Variant
ReDim x( 1  To  10 ) As Variant
For i =  1  To  10 
    x(i) = i
    Debug.Print x(i)
Next i

Call RecordsetSort(x)
For i =  1  To  10 
    Debug.Print x(i)
Next i
End Sub

Sub test()
Dim x() As Variant
elem =  1000000 
ReDim x( 1  To elem) As Variant
m = Now
    For i =  1  To elem
        x(i) = CStr(i)
    Next i
Debug.Print "Время заполнения массива:" & Format(Now - m, "s")
m = Now
Call RecordsetSort(x)
Debug.Print "Время сортировки:" & Format(Now - m, "s")
Debug.Print "Первый элемент массива:" & x( 1 )


m = Now
For i =  1  To elem
    x(i) = CStr(i)
Next i
Debug.Print "Время заполнения массива:" & Format(Now - m, "s")

m = Now
Call QuickSort(x, , True)
Debug.Print "Время сортировки:" & Format(Now - m, "s")
Debug.Print "Первый элемент массива:" & x( 1 )

End Sub

Sub test()
Dim x() As Variant
elem =  100 
progonov =  5000 

ReDim x( 1  To elem) As Variant

    m = Now
For l =  1  To progonov
    For i =  1  To elem
        x(i) = i + i /  1000 
    Next i
Call RecordsetSort(x)
Next l
Debug.Print "Время сортировки:" & Format(Now - m, "s")
  '---------------------------
    m = Now
For l =  1  To progonov
    For i =  1  To elem
        x(i) = i + i /  1000 
    Next i
Call QuickSort(x, , True)
Next l
Debug.Print "Время сортировки:" & Format(Now - m, "s")

End Sub

Public Declare Function GetTickCount Lib "kernel32" () As Long
Sub test()
Dim x() As Variant
Dim y() As Variant
elem =  10000 
Randomize
For l =  1  To  10 
m = GetTickCount
ReDim x( 1  To elem) As Variant
ReDim y( 1  To elem) As Variant
    For i =  1  To elem
        x(i) = Round(Rnd *  1000 ,  0 )
    Next i

    For i =  1  To elem
        y(i) = x(i)
    Next i
Debug.Print "Итерация " & l & "____________________________"
m = GetTickCount
Call QuickSortNonRecursive(x)
Debug.Print "Время сортировки QSNR:" & GetTickCount - m

m = GetTickCount
Call QuickSort(y, , True)
Debug.Print "Время сортировки QS:" & GetTickCount - m
Next l
End Sub