VBA数组排序函数？

Question

VBA数组排序函数？我正在为VBA中的数组寻找一个合适的排序实现。最好是速战速决。或任何其他排序算法除了泡泡或合并之外，就足够了。请注意，这是与MSProject 2003一起使用的，因此应该避免使用任何Excel本机函数和任何与.NET相关的内容。

Answer 1

我将“快速排序”算法转换为VBA，如果其他人想要的话。

我对其进行了优化，以便在Int/Longs数组上运行，但将其转换为对任意可比较元素工作的方法应该非常简单。

Private Sub QuickSort(ByRef a() As Long, ByVal l As Long, ByVal r As Long)
    Dim M As Long, i As Long, j As Long, v As Long
    M = 4

    If ((r - l) > M) Then
        i = (r + l) / 2
        If (a(l) > a(i)) Then swap a, l, i '// Tri-Median Methode!'
        If (a(l) > a(r)) Then swap a, l, r        If (a(i) > a(r)) Then swap a, i, r

        j = r - 1
        swap a, i, j
        i = l
        v = a(j)
        Do
            Do: i = i + 1: Loop While (a(i) < v)
            Do: j = j - 1: Loop While (a(j) > v)
            If (j < i) Then Exit Do
            swap a, i, j        Loop
        swap a, i, r - 1
        QuickSort a, l, j
        QuickSort a, i + 1, r    End IfEnd SubPrivate Sub swap(ByRef a() As Long, ByVal i As Long, ByVal j As Long)
    Dim T As Long
    T = a(i)
    a(i) = a(j)
    a(j) = TEnd SubPrivate Sub InsertionSort(ByRef a(), ByVal lo0 As Long, ByVal hi0 As Long)
    Dim i As Long, j As Long, v As Long

    For i = lo0 + 1 To hi0
        v = a(i)
        j = i        Do While j > lo0            If Not a(j - 1) > v Then Exit Do
            a(j) = a(j - 1)
            j = j - 1
        Loop
        a(j) = v    Next iEnd SubPublic Sub sort(ByRef a() As Long)
    QuickSort a, LBound(a), UBound(a)
    InsertionSort a, LBound(a), UBound(a)End Sub

Answer 2

解释在德文中，代码是一个经过良好测试的就地实现：

Private Sub QuickSort(ByRef Field() As String, ByVal LB As Long, ByVal UB As Long)
    Dim P1 As Long, P2 As Long, Ref As String, TEMP As String

    P1 = LB
    P2 = UB
    Ref = Field((P1 + P2) / 2)

    Do
        Do While (Field(P1) < Ref)
            P1 = P1 + 1
        Loop

        Do While (Field(P2) > Ref)
            P2 = P2 - 1
        Loop

        If P1 <= P2 Then
            TEMP = Field(P1)
            Field(P1) = Field(P2)
            Field(P2) = TEMP

            P1 = P1 + 1
            P2 = P2 - 1
        End If
    Loop Until (P1 > P2)

    If LB < P2 Then Call QuickSort(Field, LB, P2)
    If P1 < UB Then Call QuickSort(Field, P1, UB)End Sub

像这样被引用：

Call QuickSort(MyArray, LBound(MyArray), UBound(MyArray))