在 VBA 中对数组进行排序
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/45824126/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Sort array in VBA
提问by eduardo0
I have a 182.123 size array and I want to sort them by an specific attribute of the class of the array. The class is called CFlujo and the property I want to sort them by is by a string called id_flujo. So far I'm doing a bubble sort like this but it just takes too long:
我有一个 182.123 大小的数组，我想按数组类的特定属性对它们进行排序。该类称为 CFlujo，我想对它们进行排序的属性是一个名为 id_flujo 的字符串。到目前为止，我正在做这样的冒泡排序，但时间太长了：
Sub sort_arreglo(arreglo As Variant)
For x = LBound(arreglo) To UBound(arreglo)
For y = x To UBound(arreglo)
Dim aux As CFlujo
aux = New CFlujo
If UCase(arreglo(y).id_flujo) < UCase(arreglo(x).id_flujo) Then
Set aux = arreglo(y)
Set arreglo(y) = arreglo(x)
Set arreglo(x) = aux
End If
Next y
Next x
End Sub
So far I've researched the Selection Sortbut I know you can't delete items from an array so I can't make two lists to sort the values from one to the other. I could put my data in collection but I have had trouble regarding the quality of the data unless I alocate the memory beforehand (like in an array).
到目前为止，我已经研究了选择排序，但我知道您无法从数组中删除项目，因此我无法制作两个列表来将值从一个排序到另一个。我可以把我的数据收集起来，但我在数据质量方面遇到了麻烦，除非我事先分配了内存（比如在数组中）。
采纳答案by Florent B.
There's a couple of things you can do to improve the execution time:
您可以采取以下措施来缩短执行时间：
- Load all the properties in an array
- Sort some pointers instead of the objects
- Use a better algorithm like QucikSort
- 加载数组中的所有属性
- 排序一些指针而不是对象
- 使用更好的算法，如QucikSort
With you example:
以你为例：
Sub Sort(arreglo As Variant)
Dim cache, vals(), ptrs() As Long, i As Long
ReDim vals(LBound(arreglo) To UBound(arreglo))
ReDim ptrs(LBound(arreglo) To UBound(arreglo))
' load the properties and fill the pointers
For i = LBound(arreglo) To UBound(arreglo)
vals(i) = UCase(arreglo(i).id_flujo)
ptrs(i) = i
Next
' sort the pointers
QuickSort vals, ptrs, 0, UBound(vals)
' make a copy
cache = arreglo
' set the value for each pointer
For i = LBound(arreglo) To UBound(arreglo)
Set arreglo(i) = cache(ptrs(i))
Next
End Sub
Private Sub QuickSort(vals(), ptrs() As Long, ByVal i1 As Long, ByVal i2 As Long)
Dim lo As Long, hi As Long, p As Long, tmp As Long
lo = i1
hi = i2
p = ptrs((i1 + i2) \ 2)
Do
While vals(ptrs(lo)) < vals(p): lo = lo + 1: Wend
While vals(ptrs(hi)) > vals(p): hi = hi - 1: Wend
If lo <= hi Then
tmp = ptrs(hi)
ptrs(hi) = ptrs(lo)
ptrs(lo) = tmp
lo = lo + 1
hi = hi - 1
End If
Loop While lo <= hi
If i1 < hi Then QuickSort vals, ptrs, i1, hi
If lo < i2 Then QuickSort vals, ptrs, lo, i2
End Sub
