Comment puis-je trier une collection?

Tard pour le jeu... voici une implémentation de la MergeSort algorithme en VBA pour les deux Tableaux et les Collections. J'ai testé les performances de cette mise en œuvre à l'encontre de la BubbleSort mise en œuvre de la accepté de répondre à l'aide de chaines générées aléatoirement. Le tableau ci-dessous résume les résultats, c'est à dire que vous ne devez pas utiliser BubbleSort pour trier une collection VBA.

Vous pouvez télécharger le code source de mon GitHub ou tout simplement copier/coller le code source ci-dessous dans les modules appropriés.

Pour une collection col, il suffit d'appeler Collections.sort col.

Collections module

'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

Module tableaux

    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 classe

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

Si aucune IVariantComparator est fourni à l' sort méthodes, puis de l'ordre naturel qui est utilisé. Toutefois, si vous avez besoin de définir un ordre de tri différent (par exemple, l'envers), ou si vous voulez trier des objets personnalisés, vous pouvez mettre en œuvre la IVariantComparator interface. Par exemple, pour trier dans l'ordre inverse, il suffit de créer une classe appelée CReverseComparator avec le code suivant:

CReverseComparator classe

Option Explicit
Implements IVariantComparator
Public Function IVariantComparator_compare(v1 As Variant, v2 As Variant) As Long
IVariantComparator_compare = v2-v1
End Function

Ensuite appeler la fonction de tri comme suit: Collections.sort col, New CReverseComparator

Matériel Bonus: Pour une comparaison visuelle entre les performances des différents algorithmes de tri découvrez https://www.toptal.com/developers/sorting-algorithms/

Collection est plutôt du mauvais objet pour le tri.

Le point de collecte est de fournir très vite accès à un certain élément identifié par une clé. Comment les articles sont stockés en interne devrait être hors de propos.

Vous pouvez envisager d'utiliser des tableaux à la place de collections, si vous avez réellement besoin de tri.

---

Autres que que, oui, vous pouvez trier les éléments dans une collection.

Vous avez besoin de prendre tout algorithme de tri disponibles sur Internet (vous pouvez google inplementations dans pratiquement n'importe quelle langue) et d'apporter une modification mineure où un échange se produit (d'autres changements sont inutiles car vba collections, comme des tableaux, peut être consulté avec les indices). Pour échanger deux éléments dans une collection, vous devez les supprimer à la fois de la collecte et de l'insérer à la bonne position (à l'aide de la troisième ou de la quatrième paramètre de la Add méthode).

Si votre collection ne contient pas d'objets et vous avez seulement besoin de trier par ordre croissant, vous pourriez trouver cela plus facile à comprendre:

Sub Sort(ByVal C As Collection)
Dim I As Long, J As Long
For I = 1 To C.Count - 1
For J = I + 1 To C.Count
If C(I) > C(J) Then Swap C, I, J
Next
Next
End Sub
'Take good care that J > I
Sub Swap(ByVal C As Collection, ByVal I As Long, ByVal J As Long)
C.Add C(J), , , I
C.Add C(I), , , J + 1
C.Remove I
C.Remove J
End Sub

J'ai piraté le cette en quelques minutes, et si cela peut ne pas être le meilleur de tri à bulles, mais il devrait être facile à comprendre, et donc facile à modifier pour votre propre usage.

C'est ma mise en œuvre de BubbleSort:

Public Function BubbleSort(ByRef colInput As Collection, _
Optional asc = True) As Collection
Dim temp                    As Variant
Dim counterA                As Long
Dim counterB                As Long
For counterA = 1 To colInput.Count - 1
For counterB = counterA + 1 To colInput.Count
Select Case asc
Case True:
If colInput(counterA) > colInput(counterB) Then
temp = colInput(counterB)
colInput.Remove counterB
colInput.Add temp, temp, counterA
End If
Case False:
If colInput(counterA) < colInput(counterB) Then
temp = colInput(counterB)
colInput.Remove counterB
colInput.Add temp, temp, counterA
End If
End Select
Next counterB
Next counterA
Set BubbleSort = colInput
End Function
Public Sub TestMe()
Dim myCollection    As New Collection
Dim element         As Variant
myCollection.Add "2342"
myCollection.Add "vityata"
myCollection.Add "na"
myCollection.Add "baba"
myCollection.Add "ti"
myCollection.Add "hvarchiloto"
myCollection.Add "stackoveflow"
myCollection.Add "beta"
myCollection.Add "zuzana"
myCollection.Add "zuzan"
myCollection.Add "2z"
myCollection.Add "alpha"
Set myCollection = BubbleSort(myCollection)
For Each element In myCollection
Debug.Print element
Next element
Debug.Print "--------------------"
Set myCollection = BubbleSort(myCollection, False)
For Each element In myCollection
Debug.Print element
Next element
End Sub

Il prend de la collecte, par référence, donc il peut facilement retourner comme une fonction et c'est un paramètre facultatif pour les Ascendants et descendants de tri.
Le tri est de retour cette dans la fenêtre exécution:

2342
2z
alpha
baba
beta
hvarchiloto
na
stackoveflow
ti
vityata
zuzan
zuzana
--------------------
zuzana
zuzan
vityata
ti
stackoveflow
na
hvarchiloto
beta
baba
alpha
2z
2342