¿Cómo ordeno una colección?

Question

¿Alguien sabe cómo ordenar una colección en VBA?

Answer 1

El código de abajo de esta post uses a bubble sort

Sub SortCollection() 

    Dim cFruit As Collection 
    Dim vItm As Variant 
    Dim i As Long, j As Long 
    Dim vTemp As Variant 

    Set cFruit = New Collection 

    'fill the collection 
    cFruit.Add "Mango", "Mango" 
    cFruit.Add "Apple", "Apple" 
    cFruit.Add "Peach", "Peach" 
    cFruit.Add "Kiwi", "Kiwi" 
    cFruit.Add "Lime", "Lime" 

    'Two loops to bubble sort 
    For i = 1 To cFruit.Count - 1 
     For j = i + 1 To cFruit.Count 
      If cFruit(i) > cFruit(j) Then 
       'store the lesser item 
       vTemp = cFruit(j) 
       'remove the lesser item 
       cFruit.Remove j 
       're-add the lesser item before the 
       'greater Item 
       cFruit.Add vTemp, vTemp, i 
      End If 
     Next j 
    Next i 

    'Test it 
    For Each vItm In cFruit 
     Debug.Print vItm 
    Next vItm 

End Sub 

Answer 2

No existe una ordenación nativa para Collection en VBA, pero como puede acceder a los elementos de la colección a través del índice, puede implementar un algoritmo de clasificación para examinar la colección y clasificarla en una nueva colección.

Aquí hay una HeapSort algorithm implementation para VBA/VB 6.

Esto es lo que parece ser un BubbleSort algorithm implementation para VBA/VB6.

Answer 3

La colección es un objeto bastante erróneo para la clasificación.

El objetivo de una colección es proporcionar un acceso muy rápido a un determinado elemento identificado por una tecla. La forma en que los artículos se almacenan internamente debe ser irrelevante.

Es posible que desee considerar el uso de matrices en lugar de colecciones si realmente necesita clasificación.

---

Aparte de eso, sí, puede ordenar los elementos de una colección.
Necesita tomar cualquier algoritmo de clasificación disponible en Internet (puede realizar implementaciones en Google básicamente en cualquier idioma) y realizar un cambio menor cuando se produce un intercambio (otros cambios son innecesarios ya que las colecciones vba, como matrices, se pueden acceder con índices) . Para intercambiar dos elementos en una colección, debe eliminarlos de la colección e insertarlos nuevamente en las posiciones correctas (utilizando el tercer o el cuarto parámetro del método Add).

Answer 4

Si su colección no contiene objetos y sólo es necesario para orden ascendente, es posible encontrarlo más fácil de entender:

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 

Pirateé esto en minutos, por lo que puede que este no sea el mejor tipo de burbuja, pero debería ser fácil de entender y, por lo tanto, fácil de modificar para sus propios fines.

Answer 5

Este fragmento de código funciona bien, pero está en Java.

Para traducirlo usted podría hacerlo de esta manera:

Function CollectionSort(ByRef oCollection As Collection) As Long 
Dim smTempItem1 As SeriesManager, smTempItem2 As SeriesManager 
Dim i As Integer, j As Integer 
i = 1 
j = 1 

On Error GoTo ErrFailed 
Dim swapped As Boolean 
swapped = True 
Do While (swapped) 
    swapped = False 
    j = j + 1 

    For i = 1 To oCollection.Count - 1 - j 
     Set smTempItem1 = oCollection.Item(i) 
     Set smTempItem2 = oCollection.Item(i + 1) 

     If smTempItem1.Diff > smTempItem2.Diff Then 
      oCollection.Add smTempItem2, , i 
      oCollection.Add smTempItem1, , i + 1 

      oCollection.Remove i + 1 
      oCollection.Remove i + 2 

      swapped = True 
     End If 
    Next 
Loop 
Exit Function 

ErrFailed: 
    Debug.Print "Error with CollectionSort: " & Err.Description 
    CollectionSort = Err.Number 
    On Error GoTo 0 
End Function 

SeriesManager es sólo una clase que almacena la diferencia entre los valores. Realmente puede ser cualquier valor numérico que desee ordenar. Esto por defecto se ordena en orden ascendente.

Tuve dificultades para ordenar una colección en vba sin hacer una clase personalizada.

Answer 6

Puede usar ListView. Aunque es un objeto UI, puede usar su funcionalidad. Es compatible con la clasificación. Puede almacenar datos en Listview.ListItems y luego clasificar así:

Dim lv As ListView 
Set lv = New ListView 

lv.ListItems.Add Text:="B" 
lv.ListItems.Add Text:="A" 

lv.SortKey = 0   ' sort based on each item's Text 
lv.SortOrder = lvwAscending 
lv.Sorted = True 
MsgBox lv.ListItems(1) ' returns "A" 
MsgBox lv.ListItems(2) ' returns "B" 

Answer 7

tarde al juego ... aquí es una implementación de la MergeSort algorithm en VBA para ambas matrices y colecciones.Probé el rendimiento de esta implementación frente a la implementación de BubbleSort en la respuesta aceptada mediante cadenas generadas aleatoriamente. El siguiente cuadro resume los resultados, es decir, you should not use BubbleSort to sort a VBA collection.

se puede descargar el código fuente de mi GitHub Repository o simplemente copiar/pegar el código fuente abajo en los módulos correspondientes. Para obtener una colección col, solo llame al Collections.sort col.

Colecciones módulo

'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 

módulo de matrices

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 

clase 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 

I f no IVariantComparator se proporciona a los métodos sort, luego se supone el orden natural. Sin embargo, si necesita definir un orden de clasificación diferente (por ejemplo, invertir) o si desea ordenar objetos personalizados, puede implementar la interfaz IVariantComparator. Por ejemplo, para ordenar en orden inverso, basta con crear una clase llamada CReverseComparator con el siguiente código:

clase CReverseComparator

Option Explicit 

Implements IVariantComparator 

Public Function IVariantComparator_compare(v1 As Variant, v2 As Variant) As Long 
    IVariantComparator_compare = v2-v1 
End Function 

luego llamar a la función de clasificación de la siguiente manera: Collections.sort col, New CReverseComparator

Bono Material: Para una comparación visual del rendimiento de los diferentes algoritmos de clasificación, consulte https://www.toptal.com/developers/sorting-algorithms/

Answer 8

Esta es mi implementación de BubbleSort:

Option Explicit 

Public Function fnVarBubbleSort(ByRef colInput As Collection, Optional bAsc = True) As Collection 

    Dim varTemp     As Variant 
    Dim lngCounter    As Long 
    Dim lngCounter2    As Long 

    For lngCounter = 1 To colInput.Count - 1 
     For lngCounter2 = lngCounter + 1 To colInput.Count 
      Select Case bAsc 
      Case True: 
       If colInput(lngCounter) > colInput(lngCounter2) Then 
        varTemp = colInput(lngCounter2) 
        colInput.Remove lngCounter2 
        colInput.Add varTemp, varTemp, lngCounter 
       End If 

      Case False: 
       If colInput(lngCounter) < colInput(lngCounter2) Then 
        varTemp = colInput(lngCounter2) 
        colInput.Remove lngCounter2 
        colInput.Add varTemp, varTemp, lngCounter 
       End If 
      End Select 
     Next lngCounter2 
    Next lngCounter 

    Set fnVarBubbleSort = colInput 

End Function 

Public Sub TestMe() 

    Dim colCollection As New Collection 
    Dim varElement  As Variant 

    colCollection.Add "2342" 
    colCollection.Add "vityata" 
    colCollection.Add "na" 
    colCollection.Add "baba" 
    colCollection.Add "ti" 
    colCollection.Add "hvarchiloto" 
    colCollection.Add "stackoveflow" 
    colCollection.Add "beta" 
    colCollection.Add "zuzana" 
    colCollection.Add "zuzan" 
    colCollection.Add "2z" 
    colCollection.Add "alpha" 

    Set colCollection = fnVarBubbleSort(colCollection) 

    For Each varElement In colCollection 
     Debug.Print varElement 
    Next varElement 

    Debug.Print "--------------------" 

    Set colCollection = fnVarBubbleSort(colCollection, False) 

    For Each varElement In colCollection 
     Debug.Print varElement 
    Next varElement 
End Sub 

Se necesita la colección de referencia, por lo que fácilmente puede devolverlo como una función y tiene un parámetro opcional para Subiendo y bajando escaleras de clasificación. Los rendimientos de clasificación esta en la ventana inmediata:

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