谁有一维数组排序的函数,给贴上来,谢谢啦

Question

求一维数组排序的函数

Answer 1

Public Function SwapSort(TargetArray() As Variant, StartElm As Long, EndElm As Long, BackProc As Boolean) As Boolean
'**********************************************************************************
' 名    称: 冒泡排序函数
' 作    用: 对任意类型的一维数组进行升序冒泡法排序
' 参 数 表: TargetArray() As Variant    待排序数组
'           StartElm      As Long       起始元素编号
'           EndElm        As Long       终止元素编号
'           BackProc      As Boolean    是否后台排序, 会影响速度
' 返 回 值: TargetArray() As Variant    排序后的数组
'           SwapSort      As Boolean    返回 True 时排序完成
'**********************************************************************************
    SwapSort = False
'    If IsArray(TargetArray) = False Then
'        MsgBox "TargetArray 必须为一个数组 !", vbOKOnly + vbExclamation, "SwapSort"
'        Exit Function
'    End If
    Do
        If BackProc Then DoEvents
    Loop Until m_SwapSort(TargetArray(), StartElm, EndElm) = 0
    SwapSort = True
End FunctionPrivate Function m_SwapSort(TargetArray() As Variant, StartElm As Long, EndElm As Long) As Long
'**********************************************************************************
' 名    称: 冒泡排序函数主函数(仅供中间调用)
' 返 回 值: m_SwapSort As Long  本次交换次数, 为 0 时为排序完成
'**********************************************************************************
    Dim i As Long           '计数器
    For i = StartElm To EndElm - 1
        If TargetArray(i) > TargetArray(i + 1) Then
            Swap TargetArray(i), TargetArray(i + 1)
            m_SwapSort = m_SwapSort + 1
        End If
    Next i
    For i = EndElm To StartElm + 1 Step -1
        If TargetArray(i) < TargetArray(i - 1) Then
            Swap TargetArray(i), TargetArray(i - 1)
            m_SwapSort = m_SwapSort + 1
        End If
    Next i
End FunctionPublic Function QuickSort(TargetArray() As Variant, StartElm As Long, EndElm As Long, BackProc As Boolean) As Boolean
'**********************************************************************************
' 名    称: 快速排序函数
' 作    用: 对任意类型的一维数组进行升序快速法排序
' 参 数 表: TargetArray() As Variant    待排序数组
'           StartElm      As Long       起始元素编号
'           EndElm        As Long       终止元素编号
'           BackProc      As Boolean    是否后台排序, 会影响速度
' 返 回 值: TargetArray() As Variant    排序后的数组
'           QuickSort     As Boolean    返回 True 时排序完成
'**********************************************************************************
    Dim i As Long
    QuickSort = False
    If (EndElm - StartElm > 10) Then
        i = m_QuickSort(TargetArray(), StartElm, EndElm, BackProc)
        QuickSort TargetArray(), StartElm, i - 1, BackProc
        QuickSort TargetArray(), i + 1, EndElm, BackProc
    Else
        SwapSort TargetArray(), StartElm, EndElm, BackProc
    End If
    QuickSort = True
End FunctionPrivate Function m_QuickSort(TargetArray() As Variant, StartElm As Long, EndElm As Long, BackProc As Boolean) As Long
'**********************************************************************************
' 名    称: 快速排序函数主函数(仅供中间调用)
' 返 回 值: m_QuickSort As Long  本次分割点
'**********************************************************************************
    Dim i As Long, j As Long, k As Long, l As Long, t As Variant
    i = StartElm
    j = EndElm
    k = (i + j) / 2
    If ((TargetArray(i) >= TargetArray(j)) And (TargetArray(j) >= TargetArray(k))) Then
        l = j
    ElseIf ((TargetArray(i) >= TargetArray(j)) And (TargetArray(k) >= TargetArray(j))) Then
        l = k
    Else
        l = i
    End If
    t = TargetArray(l)
    TargetArray(l) = TargetArray(i)
    While (i <> j)
        While ((i < j) And (TargetArray(j) >= t))
            j = j - 1
        Wend
        If (i < j) Then
            TargetArray(i) = TargetArray(j)
            i = i + 1
            While ((i < j) And (TargetArray(i) <= t))
                i = i + 1
            Wend
            If (i < j) Then
                TargetArray(j) = TargetArray(i)
                j = j - 1
            End If
        End If
    Wend
    TargetArray(i) = t
    m_QuickSort = i
End Function数据类型是 Variant，自己按需求改改就行

Answer 2

上面程序中用到了以下方法Public Sub Swap(a As Variant, b As Variant)
    Dim c As Variant
    c = a
    a = b
    b = c
End Sub