VBA 按值对集合进行排序
VBA sorting a collection by value
我下面有 VBA 合集
我想按值排序,这样集合将在最高索引位置以最高双精度值结束(即 "e" 值 14 在第一个索引中,"c"值 10 是第二个,等等)。这怎么可能?
Public Function SortCollection(ByVal c As Collection) As Collection
Dim n As Long: n = c.Count
If n = 0 Then
Set SortCollection = New Collection
Exit Function
ReDim Index(0 To n - 1) As Long ' allocate index array
Dim i As Long, m As Long
For i = 0 To n - 1: Index(i) = i + 1: Next ' fill index array
For i = n \ 2 - 1 To 0 Step -1 ' generate ordered heap
Heapify c, Index, i, n
Next
For m = n To 2 Step -1 ' sort the index array
Exchange Index, 0, m - 1 ' move highest element to top
Heapify c, Index, 0, m - 1
Next
Dim c2 As New Collection
For i = 0 To n - 1 ' fill output collection
c2.Add c.item(Index(i))
Next
Set SortCollection = c2
End Function
Private Sub Heapify(ByVal c As Collection, Index() As Long, ByVal i1 As Long, ByVal n As Long)
' Heap order rule: a[i] >= a[2*i+1] and a[i] >= a[2*i+2]
Dim nDiv2 As Long: nDiv2 = n \ 2
Dim i As Long: i = i1
Do While i < nDiv2
Dim k As Long: k = 2 * i + 1
If k + 1 < n Then
If c.item(Index(k)) < c.item(Index(k + 1)) Then k = k + 1
End If
If c.item(Index(i)) >= c.item(Index(k)) Then Exit Do
Exchange Index, i, k
i = k
Loop
End Sub
Private Sub Exchange(Index() As Long, ByVal i As Long, ByVal j As Long)
Dim Temp As Long: Temp = Index(i)
Index(i) = Index(j)
Index(j) = Temp
End Sub
根据 Domenic 的评论,他没有回答。
"If you use a Dictionary object instead of a Collection and you can sort by value as shown here. – Domenic Aug 30 at 22:29 "
现在可以了。
我下面有 VBA 合集
我想按值排序,这样集合将在最高索引位置以最高双精度值结束(即 "e" 值 14 在第一个索引中,"c"值 10 是第二个,等等)。这怎么可能?
Public Function SortCollection(ByVal c As Collection) As Collection
Dim n As Long: n = c.Count
If n = 0 Then
Set SortCollection = New Collection
Exit Function
ReDim Index(0 To n - 1) As Long ' allocate index array
Dim i As Long, m As Long
For i = 0 To n - 1: Index(i) = i + 1: Next ' fill index array
For i = n \ 2 - 1 To 0 Step -1 ' generate ordered heap
Heapify c, Index, i, n
Next
For m = n To 2 Step -1 ' sort the index array
Exchange Index, 0, m - 1 ' move highest element to top
Heapify c, Index, 0, m - 1
Next
Dim c2 As New Collection
For i = 0 To n - 1 ' fill output collection
c2.Add c.item(Index(i))
Next
Set SortCollection = c2
End Function
Private Sub Heapify(ByVal c As Collection, Index() As Long, ByVal i1 As Long, ByVal n As Long)
' Heap order rule: a[i] >= a[2*i+1] and a[i] >= a[2*i+2]
Dim nDiv2 As Long: nDiv2 = n \ 2
Dim i As Long: i = i1
Do While i < nDiv2
Dim k As Long: k = 2 * i + 1
If k + 1 < n Then
If c.item(Index(k)) < c.item(Index(k + 1)) Then k = k + 1
End If
If c.item(Index(i)) >= c.item(Index(k)) Then Exit Do
Exchange Index, i, k
i = k
Loop
End Sub
Private Sub Exchange(Index() As Long, ByVal i As Long, ByVal j As Long)
Dim Temp As Long: Temp = Index(i)
Index(i) = Index(j)
Index(j) = Temp
End Sub
根据 Domenic 的评论,他没有回答。
"If you use a Dictionary object instead of a Collection and you can sort by value as shown here. – Domenic Aug 30 at 22:29 "
现在可以了。