BubbleSort_Counting_Counting_WorkShtSort Sort

Sub Main()
    Application.ScreenUpdating = False
    On Error GoTo Line
    Dim Ar(), NO As Integer
    Ar = Application.WorksheetFunction.Transpose((Range("a1").CurrentRegion.Value))
    NO = VBA.InputBox("输入算法方式: 1、BubbleSort,2、CountingSort,3、QuickSort，4、WorksheetSort", "方式选择", "1") '
    Dim T
    T = Timer
    Select Case NO
        Case Is = 1
            BubbleSort Ar
        Case Is = 2
            CountingSort Ar
        Case Is = 3
            QuickSort Ar, LBound(Ar), UBound(Ar)
        Case Is = 4
            WorkShtSort Ar
        Case Else
            MsgBox "错误输入", vbInformation + vbOKOnly
            Exit Sub
    End Select
    
    Range("c1").Resize(UBound(Ar), 1) = Application.WorksheetFunction.Transpose(Ar)
    Application.ScreenUpdating = True
    MsgBox Format(Timer - T, "0.00Sec"), vbInformation + vbOKOnly
    Exit Sub
Line:          MsgBox Err.Description
End Sub

'====================================================冒泡排序===================================================
Sub BubbleSort(ByRef list) 'ByRef 引用传递
    Dim L As Long, H As Long  '上下标
    Dim i As Long, J As Long
    Dim Temp '过渡
    L = LBound(list): H = UBound(list)
    For i = 1 To (H - 1) '有序区间极值
        For J = (i + 1) To H '无序区间每个值
            If list(i) > list(J) Then
                Temp = list(i) ' 取出较大值指向H 即升序
                list(i) = list(J)
                list(J) = Temp
            End If
        Next J
    Next i
End Sub

'==================================================计数排序=====================================================
Sub CountingSort(ByRef list) '只适合long类型的数组
    Dim Lo As Long, Hi As Long, Count() '2个极值和Count存储数组
    Dim L As Long, H As Long '上下标
    Dim i As Long, J As Long
    Lo = Application.WorksheetFunction.min(list)
    Hi = Application.WorksheetFunction.max(list)
    ReDim Count(Lo To Hi)
    L = LBound(list): H = UBound(list)
    '遍历list 填充Count数组
    For i = L To H
        Count(list(i)) = Count(list(i)) + 1 '索引++
    Next i
    
    Dim K As Long  '初始下标
    K = L
    '遍历Count数组 排序list
    For i = Lo To Hi '升序
        For J = 1 To Count(i)
            list(K) = i
            K = K + 1
        Next J
    Next i
End Sub

'==================================================快速排序=====================================================
Sub QuickSort(ByRef list, L, H) 'LH 左右指针，二分区间
    If L >= H Then Exit Sub
    Dim RValue As Long, Rd As Long
    Randomize '初始化
    Rd = Int((H - L + 1) * Rnd + L)
    RValue = list(Rd) '基准值
    list(Rd) = list(L)
    
    Dim Lo As Long, Hi As Long '二分法上下限
    Lo = L: Hi = H
    Do   '大循环'挖坑法
        Do While list(Hi) >= RValue ' Hi>>>>Lo
            Hi = Hi - 1
            If Hi = Lo Then Exit Do '指针相遇即退出
        Loop
        If Hi = Lo Then
            list(Lo) = RValue '不满足排序的递归前需要list元素还原
            Exit Do '退出大循环
        Else
            list(Lo) = list(Hi)
        End If
        '-----------------------------------------
        Do While list(Lo) < RValue 'Lo>>>>Hi
            Lo = Lo + 1
            If Hi = Lo Then Exit Do '指针相遇即退出
        Loop
        If Lo = Hi Then
            list(Hi) = RValue '不满足排序的递归前需要list元素还原
            Exit Do '退出大循环
        Else
            list(Hi) = list(Lo)
        End If
    Loop
    '------递归------
    QuickSort list, L, Lo - 1
    QuickSort list, Lo + 1, H
End Sub

'================================================工作表排序=====================================================
Sub WorkShtSort(ByRef list)
    Application.DisplayAlerts = False
    Dim Sht As Worksheet
    Set Sht = Worksheets.Add(after:=Sheets(Sheets.Count))
    Range("a1").Resize(UBound(list), 1) = Application.WorksheetFunction.Transpose(list)
    Range("a1").Resize(UBound(list), 1).Sort key1:=Range("a1")
    list = Application.WorksheetFunction.Transpose((Range("a1").CurrentRegion.Value))
    Sht.Delete
    Application.DisplayAlerts = True
End Sub