Как сортировать коллекцию?

Question

Кто-нибудь знает, как сортировать коллекцию в VBA?

Answer 1

Код ниже от этого 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

В VBA нет родной сортировки для Collection, но поскольку вы можете получить доступ к элементам в коллекции по индексу, вы можете реализовать алгоритм сортировки, чтобы просмотреть коллекцию и отсортировать ее в новой коллекции.

Вот HeapSort algorithm implementation для VBA/VB 6.

Вот что, как представляется BubbleSort algorithm implementation для VBA/VB6.

Answer 3

Коллекция - довольно неправильный объект для сортировки.

Сама точка коллекции - обеспечить очень быстрый доступ к определенному элементу, идентифицированному ключом. Как предметы, хранящиеся внутри, должны быть неактуальными.

Возможно, вы захотите рассмотреть возможность использования массивов вместо коллекций, если вам действительно нужна сортировка.

---

Кроме этого, да, вы можете сортировать товары в коллекции.
Вам необходимо принять любой алгоритм сортировки, доступный в Интернете (вы можете использовать Google в целом на любом языке) и внести незначительные изменения там, где происходит своп (другие изменения не нужны, поскольку коллекции vba, например массивы, могут быть доступны с индексами) , Чтобы поменять два элемента в коллекции, вам необходимо удалить их из коллекции и вставить их обратно в правильные позиции (используя третий или четвертый параметр метода Add).

Answer 4

Если ваша коллекция не содержит объектов и вам нужно только для сортировки по возрастанию, вы могли бы найти это легче понять:

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 

я взломал это за считанные минуты, так что это может быть не лучший выбор пузырьков, но его нужно легко понять и, следовательно, легко изменить для своих целей.

Answer 5

Этот фрагмент кода работает хорошо, но он находится в java.

Для того, чтобы перевести его вы могли бы сделать это следующим образом:

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 это просто класс, который сохраняет разницу между значениями. Это действительно может быть любое числовое значение, которое вы хотите сортировать. Это по умолчанию сортируется в порядке возрастания.

Мне было сложно сортировать коллекцию в vba без создания пользовательского класса.

Answer 6

Вы можете использовать ListView. Хотя это объект пользовательского интерфейса, вы можете использовать его функциональность. Он поддерживает сортировку. Вы можете хранить данные в 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 7

Поздно игры ... вот реализация MergeSort algorithm в VBA для обоих массивов и коллекций.Я протестировал производительность этой реализации против реализации BubbleSort в принятом ответе, используя случайно сгенерированные строки. В приведенной ниже таблице представлены результаты, то есть you should not use BubbleSort to sort a VBA collection.

Вы можете загрузить исходный код из моего GitHub Repository или просто копировать/вставить исходный код, приведенный ниже в соответствующие модули.

Для коллекции 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 

I f no 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 

Затем вызовите функцию сортировки следующим образом: Collections.sort col, New CReverseComparator

Bonus Материал: Для визуального сравнения характеристик различных алгоритмов сортировки вы можете ознакомиться https://www.toptal.com/developers/sorting-algorithms/

Answer 8

Это моя реализация 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 

Он принимает коллекцию ссылки, таким образом, он может легко вернуть его как функцию и имеет дополнительный параметр для восходящих и нисходящих сортировки. сортировочные возвращает это в ближайшем окне:

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