Option Compare Database Option Explicit
Public Sub InitArr() Dim X, Y Dim myArr(5 To 14, 2 To 6) 'Заполняем массив For X = 5 To 14 myArr(X, 2) = Int((100 * Rnd) + 1) For Y = 1 To Int((10 * Rnd) + 1) myArr(X, 3) = myArr(X, 3) & Chr(Int((70 * Rnd) + 1) + 47) Next Y myArr(X, 4) = CDbl(Int((5000 * Rnd) + 1) / 7) myArr(X, 5) = CCur(Int((5000 * Rnd) + 1) / 7) myArr(X, 6) = CDate(Date - Int((3 * Rnd) + 1)) Debug.Print myArr(X, 2); Tab; myArr(X, 3); Tab; myArr(X, 4); Tab; myArr(X, 5); Tab; myArr(X, 6) Next X Debug.Print "===================" 'Сортируем массив SortArr myArr, Array(adInteger, adVarChar, adDouble, adCurrency, adDate), "6 ASC, 2 DESC" For X = 5 To 14 Debug.Print myArr(X, 2); Tab; myArr(X, 3); Tab; myArr(X, 4); Tab; myArr(X, 5); Tab; myArr(X, 6) Next X End Sub 'Собственно функция сортировки Public Sub SortArr(ByRef myArr, arrDataType, strSort As String) Dim X, I, Y, myArrS Dim rst As New ADODB.Recordset With rst 'Создаем рекордсет With .Fields X = LBound(myArr, 2) For Each myArrS In</font> arrDataType If myArrS = 129 Or myArrS = 200 Then .Append X, myArrS, 255 Else .Append X, myArrS X = X + 1 Next End With .CursorLocation = adUseClient .Open 'Заполняем рекордсет For I = LBound(myArr, 1) To UBound(myArr, 1) .AddNew For Y = 0 To UBound(myArr, 2) - LBound(myArr, 2) .Fields(Y) = myArr(I, Y + LBound(myArr, 2)) Next Y Next I 'Сортируем .Sort = strSort .MoveFirst 'Заполняем массив For I = LBound(myArr, 1) To UBound(myArr, 1) For Y = 0 To UBound(myArr, 2) - LBound(myArr, 2) myArr(I, Y + LBound(myArr, 2)) = Trim$(.Fields(Y)) Next Y .MoveNext Next I .Close End With Set rst = Nothing End Sub |