VBA排序之（冒泡排序、選擇排序、插入排序、快速排序、希爾排序）

主程序：

Sub mymain()
    Dim MainArr, t
    Application.ScreenUpdating = False
    t = timer
    With ThisWorkbook.Worksheets("排序")
        MainArr = .Range("a2: a" & Cells(Rows.Count, "a").End(xlUp).Row)
        InsertionSort arr:=MainArr
        .Range("c2").Resize(UBound(MainArr), 1) = MainArr
    End With
    MsgBox Format(timer - t, "0.00s")
    Application.ScreenUpdating = True
End Sub'

1、冒泡排序運作方式：
1.1、比較相鄰的兩個元素，按所需順序決定是否交換。
1.2、對每一對相鄰元素進行同樣的工作，從第一對至最后一對。結束后，最后一個元素應該是所需順序的最值（如所需順序為由小至大，則為最大值）。
1.3、對所有元素重復上述步驟，除了最后一個。
1.4、重復前述步驟，稱前部分需要對比的為無序區，后部分不需要對比的為有序區，直到無序區僅剩一個元素。

Sub BubbleSort(ByRef arr)
    Dim i&, j&, vSwap
    For i = UBound(arr) To 2 Step -1
        For j = 1 To i - 1
            If arr(j, 1) > arr(j + 1, 1) Then
                vSwap = arr(j, 1)
                arr(j, 1) = arr(j + 1, 1)
                arr(j + 1, 1) = vSwap
            End If
        Next
    Next
End Sub

 

2、選擇排序運作方式：
2.1、對（無序區）全部元素由前至后掃描，找出最值。
2.2、將最值元素與（無序區）第一個元素交換，此時前端為有序區，后端為無序區。
2.3、重復上述步驟，直到無序區僅剩一個元素。

 

Sub SelectionSort(ByRef arr)
    Dim i&, j&, vSwap, min&
    For i = 1 To UBound(arr)
        min = i
        For j = i + 1 To UBound(arr)
            If arr(min, 1) > arr(j, 1) Then min = j
        Next
        If min <> i Then
            vSwap = arr(min, 1)
            arr(min, 1) = arr(i, 1)
            arr(i, 1) = vSwap
        End If
    Next
End Sub

3、插入排序運作方式：
3.1、全部元素同樣的分為有序區在前和無序區在后，開始時有序區僅有第一個元素。
3.2、取無序區的第一個元素，與有序區中元素由后至前掃描對比。
3.3、將該元素插入至正確位置，該位置（含）之后的有序區元素向后移位，將該位置賦值為該元素。
3.4、重復上述步驟，直至無序區僅剩一個元素

Sub InsertionSort(ByRef arr)
    Dim i&, j&, vTemp
    For i = 2 To UBound(arr)
        vTemp = arr(i, 1)
        For j = i To 2 Step -1
            If arr(j - 1, 1) < vTemp Then Exit For
            arr(j, 1) = arr(j - 1, 1)
        Next
        arr(j, 1) = vTemp
    Next
End Sub

4、快速排序運作方式：
快速排序與二叉查找樹基於一樣的思路，采用了分治（Divide & Conquer）的策略。
4.1、選擇一個元素作為比較的基准（Pivot）。
4.2、將所有元素與基准逐個對比，按所需順序置於基准的兩側，如升序排列時大的放在基准右側、小的放在左側，將整個數據划分為左右兩個分區。
4.3、視左右兩個分區為兩個單獨的待排序數據，遞歸的重復上述操作，直至分區中元素只有一個。
取分區第一個元素作為基准的VBA實現，調用時 nLeft=LBound(arr): nRight=UBound(arr)

Sub QuickSort(ByRef arr, ByRef nLeft&, ByRef nRight&)
    Dim i&, j&, vKey, vSwap
    If nLeft >= nRight Then Exit Sub
    vKey = arr(nLeft, 1)
    i = nLeft + 1
    j = nRight
    Do
        Do While i <= nRight
            If arr(i, 1) > vKey Then Exit Do
            i = i + 1
        Loop
        Do While j > nLeft
            If arr(j, 1) < vKey Then Exit Do
            j = j - 1
        Loop
        If i >= j Then Exit Do
        vSwap = arr(i, 1): arr(i, 1) = arr(j, 1): arr(j, 1) = vSwap
    Loop
    If nLeft <> j Then
        vSwap = arr(nLeft, 1): arr(nLeft, 1) = arr(j, 1): arr(j, 1) = vSwap
    End If
    If nLeft < j Then Call QuickSort(arr, nLeft, j)
    If j + 1 < nRight Then Call QuickSort(arr, j + 1, nRight)
End Sub

5、希爾排序運作方式：
希爾排序是插入排序的一個優化。在插入排序中，每次對比是由后前逐個對比，或言對比的步長為1。
對比的步長可由大至小，直至步長為1變為插入排序。這樣一來在最初的幾個對比步長中，較小的元素（假設按升序排序）就會向目標位置前進一大步。
5.1、設置步長序列，由大至小。
5.2、由步長序列中，逐個獲取步長。
5.3、由源數據中第步長+1個元素向后掃描，作為基准值。
5.4、由步驟3中的基准值元素向前掃描與基准值對比，並進行必要的位移，同時每次遞減為步長而不是1。
5.5 、將基准值插入到正確的位置?
5.6、重復2、3、4、5，直至步長為1。

Sub ShellSort(ByRef arr)
    Dim i&, j&, vTemp, aGaps, nGap, nLen&
    aGaps = Array(701, 301, 132, 57, 23, 10, 4, 1)
    nLen = UBound(arr)
    For Each nGap In aGaps
        For i = nGap + 1 To nLen
            vTemp = arr(i, 1)
            For j = i To nGap + 1 Step nGap * -1
                If arr(j - nGap, 1) < vTemp Then Exit For
                arr(j, 1) = arr(j - nGap, 1)
            Next
            arr(j, 1) = vTemp
        Next
    Next
End Sub