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