Поздно к игре ... вот реализация алгоритма MergeSort в VBA для массивов и коллекций.Я проверил производительность этой реализации с реализацией BubbleSort в принятом ответе, используя случайно сгенерированные строки.В приведенной ниже таблице обобщены результаты, т.е. вы не должны использовать BubbleSort для сортировки коллекции VBA .
Вы можете загрузитьисходный код из моего репозитория GitHub или просто скопируйте приведенный ниже исходный код в соответствующие модули.
Для коллекции col, просто позвоните Collections.sort col.
Модуль коллекций
'Sorts the given collection using the Arrays.MergeSort algorithm.
' O(n log(n)) time
' O(n) space
Public Sub sort(col As collection, Optional ByRef c As IVariantComparator)
Dim a() As Variant
Dim b() As Variant
a = Collections.ToArray(col)
Arrays.sort a(), c
Set col = Collections.FromArray(a())
End Sub
'Returns an array which exactly matches this collection.
' Note: This function is not safe for concurrent modification.
Public Function ToArray(col As collection) As Variant
Dim a() As Variant
ReDim a(0 To col.count)
Dim i As Long
For i = 0 To col.count - 1
a(i) = col(i + 1)
Next i
ToArray = a()
End Function
'Returns a Collection which exactly matches the given Array
' Note: This function is not safe for concurrent modification.
Public Function FromArray(a() As Variant) As collection
Dim col As collection
Set col = New collection
Dim element As Variant
For Each element In a
col.Add element
Next element
Set FromArray = col
End Function
Модуль массивов
Option Compare Text
Option Explicit
Option Base 0
Private Const INSERTIONSORT_THRESHOLD As Long = 7
'Sorts the array using the MergeSort algorithm (follows the Java legacyMergesort algorithm
'O(n*log(n)) time; O(n) space
Public Sub sort(ByRef a() As Variant, Optional ByRef c As IVariantComparator)
If c Is Nothing Then
MergeSort copyOf(a), a, 0, length(a), 0, Factory.newNumericComparator
Else
MergeSort copyOf(a), a, 0, length(a), 0, c
End If
End Sub
Private Sub MergeSort(ByRef src() As Variant, ByRef dest() As Variant, low As Long, high As Long, off As Long, ByRef c As IVariantComparator)
Dim length As Long
Dim destLow As Long
Dim destHigh As Long
Dim mid As Long
Dim i As Long
Dim p As Long
Dim q As Long
length = high - low
' insertion sort on small arrays
If length < INSERTIONSORT_THRESHOLD Then
i = low
Dim j As Long
Do While i < high
j = i
Do While True
If (j <= low) Then
Exit Do
End If
If (c.compare(dest(j - 1), dest(j)) <= 0) Then
Exit Do
End If
swap dest, j, j - 1
j = j - 1 'decrement j
Loop
i = i + 1 'increment i
Loop
Exit Sub
End If
'recursively sort halves of dest into src
destLow = low
destHigh = high
low = low + off
high = high + off
mid = (low + high) / 2
MergeSort dest, src, low, mid, -off, c
MergeSort dest, src, mid, high, -off, c
'if list is already sorted, we're done
If c.compare(src(mid - 1), src(mid)) <= 0 Then
copy src, low, dest, destLow, length - 1
Exit Sub
End If
'merge sorted halves into dest
i = destLow
p = low
q = mid
Do While i < destHigh
If (q >= high) Then
dest(i) = src(p)
p = p + 1
Else
'Otherwise, check if p<mid AND src(p) preceeds scr(q)
'See description of following idom at: https://stackoverflow.com/a/3245183/3795219
Select Case True
Case p >= mid, c.compare(src(p), src(q)) > 0
dest(i) = src(q)
q = q + 1
Case Else
dest(i) = src(p)
p = p + 1
End Select
End If
i = i + 1
Loop
End Sub
Класс IVariantComparator
Option Explicit
'The IVariantComparator provides a method, compare, that imposes a total ordering over a collection _
of variants. A class that implements IVariantComparator, called a Comparator, can be passed to the _
Arrays.sort and Collections.sort methods to precisely control the sort order of the elements.
'Compares two variants for their sort order. Returns -1 if v1 should be sorted ahead of v2; +1 if _
v2 should be sorted ahead of v1; and 0 if the two objects are of equal precedence. This function _
should exhibit several necessary behaviors: _
1.) compare(x,y)=-(compare(y,x) for all x,y _
2.) compare(x,y)>= 0 for all x,y _
3.) compare(x,y)>=0 and compare(y,z)>=0 implies compare(x,z)>0 for all x,y,z
Public Function compare(ByRef v1 As Variant, ByRef v2 As Variant) As Long
End Function
Если sort не предоставлено IVariantComparator, то предполагается естественное упорядочение.Однако, если вам нужно определить другой порядок сортировки (например, обратный) или если вы хотите отсортировать пользовательские объекты, вы можете реализовать интерфейс IVariantComparator.Например, для сортировки в обратном порядке просто создайте класс с именем CReverseComparator со следующим кодом:
CReverseComparator class
Option Explicit
Implements IVariantComparator
Public Function IVariantComparator_compare(v1 As Variant, v2 As Variant) As Long
IVariantComparator_compare = v2-v1
End Function
Затем вызовите функцию сортировкиследующим образом: Collections.sort col, New CReverseComparator
Бонусный материал: Для визуального сравнения производительности различных алгоритмов сортировки посмотрите https://www.toptal.com/developers/sorting-algorithms/