常用代码——排序代码

冒泡排序

Function DescSortArr1(ByRef Ar())
Dim i&, j&, x, x1, x2
For i = LBound(Ar) To UBound(Ar)
    For j = i + 1 To UBound(Ar)
        x1 = Ar(i): x2 = Ar(j)
        If x2 > x1 Then
            x = Ar(i): Ar(i) = Ar(j): Ar(j) = x
        End If
    Next j
Next i
DescSortArr1 = Ar
End Function

Function AsceSortArr1(ByRef Ar())
Dim i&, j&, x, x1, x2
For i = UBound(Ar) To LBound(Ar) Step -1
    For j = UBound(Ar) To i + 1 Step -1
        x1 = Ar(i): x2 = Ar(j)
        If x2 < x1 Then
            x = Ar(i): Ar(i) = Ar(j): Ar(j) = x
        End If
    Next j
Next i
AsceSortArr1 = Ar
End Function

'二维数组降序
Function DescSortArr(ByVal ar)
    Dim i&, j&, x, x1, x2, k, m
    For i = LBound(ar) To UBound(ar)
        For j = i + 1 To UBound(ar)
            x1 = ar(i, 1): x2 = ar(j, 1)
            If x2 > x1 Then
                For k = LBound(ar, 2) To UBound(ar, 2)
                    x = ar(i, k): ar(i, k) = ar(j, k): ar(j, k) = x
                Next
            End If
        Next j
    Next i
    DescSortArr = ar
End Function

归并排序

Sub Main()
    a = Array(6, 8, 2, 3, 5)
    ReDim b(UBound(a))
    Call MergeSort(a, LBound(a), UBound(a), b)
    Debug.Print Join(a, "")
End Sub

Sub MergeSort(a, first, last, temp)
    If (first < last) Then
        center = Int((first + last) / 2)
        Call MergeSort(a, first, center, temp)
        Call MergeSort(a, center + 1, last, temp)
        Call MergeArray(a, first, center, last, temp)
    End If
End Sub

Sub MergeArray(a, first, center, last, temp)
    i = first '左序列开始序号
    j = center + 1 '右序列开始序号
    k = first  '临时数组填写索引

    While (i <= center And j <= last)  '两个序列中都有元素的情况
        If a(i) <= a(j) Then
            temp(k) = a(i)
            i = i + 1
        Else
            temp(k) = a(j)
            j = j + 1
        End If
        k = k + 1
    Wend
    While (i <= center)   '如果第1个序列中还有元素
        temp(k) = a(i)
        k = k + 1
        i = i + 1
    Wend
    While (j <= last)   '如果第2序列中还有元素
        temp(k) = a(j)
        k = k + 1
        j = j + 1
    Wend
    For i = first To last '将temp中已排序的序列传回原数组
        a(i) = temp(i)
    Next
End Sub