如何对集合进行排序？

Question

有谁知道如何在VBA中对集合进行排序？

Answer 1

游戏的后期......这是在VBA中为阵列和集合实现的MergeSort算法.我使用随机生成的字符串在接受的答案中测试了针对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

如果没有IVariantComparator提供sort方法,则假定自然排序.但是,如果需要定义不同的排序顺序(例如反向),或者如果要对自定义对象进行排序,则可以实现该IVariantComparator接口.例如,要按相反顺序排序,只需创建一个CReverseComparator使用以下代码调用的类:

CReverseComparator类

Option Explicit

Implements IVariantComparator

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

然后调用sort函数,如下所示: Collections.sort col, New CReverseComparator

奖励材料:为了直观地比较不同排序算法的性能,请查看https://www.toptal.com/developers/sorting-algorithms/

Answer 2

本文下面的代码使用冒泡排序

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 3

你可以用一个ListView.虽然它是UI对象,但您可以使用其功能.它支持排序.您可以存储数据Listview.ListItems,然后按如下方式排序:

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 4

集合是一个相当错误的排序对象.

集合的关键是提供对由密钥标识的特定元素的非常快速的访问.项目如何在内部存储应该是无关紧要的.

如果您确实需要排序,可能需要考虑使用数组而不是集合.

除此之外,是的,您可以对集合中的项目进行排序.
您需要在Internet上使用任何排序算法(您可以基本上以任何语言进行google inplementation)并在发生交换时进行微小更改(其他更改是不必要的,因为vba集合,如数组,可以使用索引访问).要交换集合中的两个项目,您需要将它们从集合中移除并将它们插回到正确的位置(使用方法的第三个或第四个参数Add).

Answer 5

CollectionVBA中没有本机排序,但由于您可以通过索引访问集合中的项目,因此您可以实现排序算法来遍历集合并排序到新集合中.

这是VBA/VB 6 的HeapSort算法实现.

这里似乎是VBA/VB6 的BubbleSort算法实现.

Answer 6

如果您的集合不包含对象并且您只需要升序排序，您可能会发现这更容易理解：

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

我在几分钟内解决了这个问题，所以这可能不是最好的冒泡排序，但它应该很容易理解，因此很容易为你自己的目的进行修改。