Цитата |
---|
Marat Ta: Тестовый файл работает у всех, кроме Jack Famous и вас |
вы снова не читаете:
Цитата |
---|
Jack Famous: Лично у меня на реальных данных даже проверить не получилось - на рабочем компе не подключается … В файле "тесты" почти все выполняются |
с файлом проблем нет, не выполняются макросы, которые НЕ ArrayList и на них ну прям совсем плевать в данном случае.
ArrayList запускается, но сравнение мне не понравилось
Подробно |
---|
У меня было 10 минут времени и очень небольшое желание сравнить скорость и качество сортировки квика и ArrayList Сделать это хотел в новом файле, самостоятельно всё подключив, проверив и замерив время прохождения каждого этапа - с ходу сделать это не получилось, т.к. на первом же элементе цикла For each x in arr, где arr - это массив с листа, возникла ошибка. Найти в себе силы разобраться в причинах НЕработы НЕинтересного мне метода, который я не собираюсь использовать, я не нашёл…вчера |
Сегодня время я нашёл, но ничего не изменилось - ошибка на месте, причина непонятна. Раннее подключение есть, но ошибка такая же, как при позднем
Кто хочет/может - увеличьте количество элементов в полях
Short и
Long (раскопировав то, что есть или своими данными), раскомментируйте блоки кода и запустите тестер (квик сортирует 100 тыс элементов, как в примере 0,3 сек)
Код и скрины |
---|
Код |
---|
Option Explicit
Option Private Module
'====================================================================================================
Sub test()
Dim arrData(), arrQ(), arrAL()
Dim t!, tt!
tt = Timer
t = Timer
arrData = [_data].Value2
Debug.Print "Get:", Fix(1000 * (Timer - t))
t = Timer
Arr2xTo1x arrData, 3
Debug.Print "Arr2xTo1x:", Fix(1000 * (Timer - t))
t = Timer
arrQ = arrData: SortQuick arrQ, 0, UBound(arrQ)
Debug.Print "SortQuick:", Fix(1000 * (Timer - t))
't = Timer
' arrAL = arrData: SortArrayList arrAL
'Debug.Print "SortAL:", Fix(1000 * (Timer - t))
't = Timer
' arrData = Arrs1xTo2x(arrQ, arrAL)
'Debug.Print "Arrs1xTo2x:", Fix(1000 * (Timer - t))
't = Timer
' Worksheets.Add after:=ActiveSheet
' Cells(1, 1).Resize(UBound(arrData, 1), UBound(arrData, 2)).Value2 = arrData
'Debug.Print "Load:", Fix(1000 * (Timer - t))
Debug.Print "Total:", Fix(1000 * (Timer - tt))
End Sub
'====================================================================================================
'====================================================================================================
' iType: 1 = short only, 2 = long only, 3 = both
Sub Arr2xTo1x(arr, iType&)
Dim arr1x(), r&, i&
ReDim arr1x(UBound(arr, 1) * UBound(arr, 2) - 1): i = -1
If iType = 3 Then
For r = 1 To UBound(arr, 1)
i = i + 1: arr1x(i) = arr(r, 1)
i = i + 1: arr1x(i) = arr(r, 2)
Next r
Else
For r = 1 To UBound(arr, 1)
i = i + 1: arr1x(i) = arr(r, iType)
Next r
End If
arr = arr1x
End Sub
'====================================================================================================
Function Arrs1xTo2x(arrL, arrR) As Variant()
Dim arrOut(), i&, r&
r = UBound(arrL): If r <> UBound(arrR) Then MsgBox "Wrong SIZE!", vbCritical, "Arrs1xTo2x": Exit Function
ReDim arrOut(1 To r + 1, 1 To 3)
For i = 0 To r
r = i + 1
arrOut(r, 1) = arrL(i)
arrOut(r, 2) = arrR(i)
arrOut(r, 3) = arrL(i) = arrR(i)
Next i
Arrs1xTo2x = arrOut
End Function
'====================================================================================================
'====================================================================================================
Sub SortQuick(arr1x(), l&, u&)
Dim i&, j&, x, y
i = l: j = u: x = arr1x((l + u) \ 2)
Do
Do While arr1x(i) < x: i = i + 1: Loop
Do While x < arr1x(j): j = j - 1: Loop
If i <= j Then y = arr1x(i): arr1x(i) = arr1x(j): arr1x(j) = y: i = i + 1: j = j - 1
Loop Until i > j
If l < j Then SortQuick arr1x, l, j
If i < u Then SortQuick arr1x, i, u
End Sub
'====================================================================================================
Sub SortArrayList(arr)
Dim x
Dim AL As New ArrayList
'Dim AL As Object: Set AL = CreateObject("System.Collections.ArrayList")
'AL.Add 1
'AL.Add 2
'AL.Add 3
For Each x In arr
AL.Add x
Next x
AL.Sort: arr = AL.ToArray: Set AL = Nothing
End Sub
'==================================================================================================== |
|
P.S.: на кой хрен
Marat Ta прислал файл "
sorting demo", в котором
вообще ArrayList нет, я не знаю
P.P.S.: Ох и наоффтопили мы тут