How do I sort a collection?

后端 未结 9 1962
臣服心动
臣服心动 2020-11-27 05:03

Does anyone know how to sort a collection in VBA?

相关标签:
9条回答
  • 2020-11-27 05:41

    If your collection doesn't contain objects and you only need to sort ascending, you might find this easier to understand:

    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
    

    I hacked this up in minutes, so this may not be the best bubble sort, but it should be easy to understand, and hence easy to modify for your own purposes.

    0 讨论(0)
  • 2020-11-27 05:42

    There is no native sort for the Collection in VBA, but since you can access items in the collection via index, you can implement a sorting algorithm to go through the collection and sort into a new collection.

    Here's a HeapSort algorithm implementation for VBA/VB 6.

    Here's what appears to be a BubbleSort algorithm implementation for VBA/VB6.

    0 讨论(0)
  • 2020-11-27 05:44

    You could use a ListView. Although it is a UI object, you can use its functionality. It supports sorting. You can store data in Listview.ListItems and then sort like this:

    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"
    
    0 讨论(0)
  • 2020-11-27 05:50

    The code below from this 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
    
    0 讨论(0)
  • 2020-11-27 05:50

    Late to the game... here's an implementation of the MergeSort algorithm in VBA for both Arrays and Collections. I tested the performance of this implementation against the BubbleSort implementation in the accepted answer using randomly generated strings. The chart below summarizes the results, i.e. that you should not use BubbleSort to sort a VBA collection.

    You can download the source code from my GitHub Repository or just copy/paste the source code below into the appropriate modules.

    For a collection col, just call 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
    

    Arrays module

        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 class

    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
    

    If no IVariantComparator is provided to the sort methods, then the natural ordering is assumed. However, if you need to define a different sort order (e.g. reverse) or if you want to sort custom objects, you can implement the IVariantComparator interface. For example, to sort in reverse order, just create a class called CReverseComparator with the following code:

    CReverseComparator class

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

    Then call the sort function as follows: Collections.sort col, New CReverseComparator

    Bonus Material: For a visual comparison of the performance of different sorting algorithms check out https://www.toptal.com/developers/sorting-algorithms/

    0 讨论(0)
  • 2020-11-27 06:01

    This code snippet works well, but it is in java.

    To translate it you could do it like this:

     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 is just a class that stores the difference between two values. It can really be any number value you want to sort on. This by default sorts in ascending order.

    I had difficulty sorting a collection in vba without making a custom class.

    0 讨论(0)
提交回复
热议问题