понедельник, 3 февраля 2014 г.

Сортировка двух массивов (сорт-ка одного массива и второго в соответствии с первым)

'Функция сортирует массив arr и в том же порядке сортирует элементы массива twoarr. Массивы начинаются с единицы
Function QuickSort(arr, twoarr)
On Error Resume Next
Print "Выполняется сортировка..."
On Error Goto ErrH
Dim count%, span%
Dim vtemp, twovtemp
Forall x In arr
count%=count%+1
End Forall
Dim i%,j%
If count% > 0 Then
span% = count% \ 2
Do While span% > 0
For i% = span% To count% -1
For j% = (i% - span% + 1) To 1 Step -span%
If arr(j%) > arr(j%+span%) Then
vtemp = arr(j%)
twovtemp=twoarr(j%)
arr(j%) = arr(j%+span%)
twoarr(j%) = twoarr(j%+span%)
arr(j%+span%) = vtemp
twoarr(j%+span%)=twovtemp
End If
Next j%
Next i%
span% = span% \ 2
Loop
End If
Print

Exit Function
ErrH: Error Err, Error$ & Chr(10) & Getthreadinfo(1) & " (line " & Erl & ")"
End Function