求助：VB排序代码，小弟工作不保求助啊！

Question

http://download.csdn.net/detail/veron_04/3058640

Answer 1

代码我贴 出来，用VB6写的'''新建bas文件
Attribute VB_Name = "Module1"
Option Explicit
Global Const ZERO = 0
Global Const ASCENDING_ORDER = 0
Global Const DESCENDING_ORDER = 1Global gIterationsSub BubbleSort(MyArray(), ByVal nOrder As Integer)
Dim Index
Dim TEMP
Dim NextElement    NextElement = ZERO
    Do While (NextElement < UBound(MyArray))
        Index = UBound(MyArray)
        Do While (Index > NextElement)
            If nOrder = ASCENDING_ORDER Then
                If MyArray(Index) < MyArray(Index - 1) Then
                    TEMP = MyArray(Index)
                    MyArray(Index) = MyArray(Index - 1)
                    MyArray(Index - 1) = TEMP
                End If
            ElseIf nOrder = DESCENDING_ORDER Then
                If MyArray(Index) >= MyArray(Index - 1) Then
                    TEMP = MyArray(Index)
                    MyArray(Index) = MyArray(Index - 1)
                    MyArray(Index - 1) = TEMP
                End If
            End If
            Index = Index - 1
            gIterations = gIterations + 1
        Loop
        NextElement = NextElement + 1
        gIterations = gIterations + 1
    LoopEnd SubSub Bucket(MyArray(), ByVal nOrder As Integer)
Dim Index
Dim NextElement
Dim TheBucket    NextElement = LBound(MyArray) + 1
    While (NextElement <= UBound(MyArray))
        TheBucket = MyArray(NextElement)
        Index = NextElement
        Do
            If Index > LBound(MyArray) Then
                If nOrder = ASCENDING_ORDER Then
                    If TheBucket < MyArray(Index - 1) Then
                        MyArray(Index) = MyArray(Index - 1)
                        Index = Index - 1
                    Else
                        Exit Do
                    End If
                ElseIf nOrder = DESCENDING_ORDER Then
                    If TheBucket >= MyArray(Index - 1) Then
                        MyArray(Index) = MyArray(Index - 1)
                        Index = Index - 1
                    Else
                        Exit Do
                    End If
                End If
            Else
                Exit Do
            End If
            gIterations = gIterations + 1
        Loop
        MyArray(Index) = TheBucket
        NextElement = NextElement + 1
        gIterations = gIterations + 1
    WendEnd Sub''堆排序
Sub Heap(MyArray())
Dim Index
Dim Size
Dim TEMP    Size = UBound(MyArray)
    
    Index = 1
    While (Index <= Size)
        Call HeapSiftup(MyArray(), Index)
        Index = Index + 1
        gIterations = gIterations + 1
    Wend    Index = Size
    While (Index > 0)
        TEMP = MyArray(0)
        MyArray(0) = MyArray(Index)
        MyArray(Index) = TEMP
        Call HeapSiftdown(MyArray(), Index - 1)
        Index = Index - 1
        gIterations = gIterations + 1
    WendEnd Sub
 Sub HeapSiftdown(MyArray(), M)
Dim Index
Dim Parent
Dim TEMP    Index = 0
    Parent = 2 * Index    Do While (Parent <= M)
        
        If (Parent < M And MyArray(Parent) < MyArray(Parent + 1)) Then
            Parent = Parent + 1
        End If        If MyArray(Index) >= MyArray(Parent) Then
            Exit Do
        End If        TEMP = MyArray(Index)
        MyArray(Index) = MyArray(Parent)
        MyArray(Parent) = TEMP
        
        Index = Parent
        Parent = 2 * Index        gIterations = gIterations + 1
    Loop
End SubSub HeapSiftup(MyArray(), M)
Dim Index
Dim Parent
Dim TEMP    Index = M
    Do While (Index > 0)
        Parent = Int(Index / 2)        If MyArray(Parent) >= MyArray(Index) Then
            Exit Do
        End If
        
        TEMP = MyArray(Index)
        MyArray(Index) = MyArray(Parent)
        MyArray(Parent) = TEMP        Index = Parent
        gIterations = gIterations + 1
    Loop
    
End SubSub Insertion(MyArray(), ByVal nOrder As Integer)
Dim Index
Dim TEMP
Dim NextElement
    
    NextElement = LBound(MyArray) + 1
    While (NextElement <= UBound(MyArray))
        Index = NextElement
        Do
            If Index > LBound(MyArray) Then
                If nOrder = ASCENDING_ORDER Then
                    If MyArray(Index) < MyArray(Index - 1) Then
                        TEMP = MyArray(Index)
                        MyArray(Index) = MyArray(Index - 1)
                        MyArray(Index - 1) = TEMP
                        Index = Index - 1
                    Else
                        Exit Do
                    End If
                ElseIf nOrder = DESCENDING_ORDER Then
                    If MyArray(Index) >= MyArray(Index - 1) Then
                        TEMP = MyArray(Index)
                        MyArray(Index) = MyArray(Index - 1)
                        MyArray(Index - 1) = TEMP
                        Index = Index - 1
                    Else
                        Exit Do
                    End If
                End If
            Else
                Exit Do
            End If
            gIterations = gIterations + 1
        Loop
        NextElement = NextElement + 1
        gIterations = gIterations + 1
    WendEnd SubSub QuickSort(MyArray(), L, R)
Dim I, J, X, Y    I = L
    J = R
    X = MyArray((L + R) / 2)
        
    While (I <= J)
        While (MyArray(I) < X And I < R)
            I = I + 1
        Wend
        While (X < MyArray(J) And J > L)
            J = J - 1
        Wend
        If (I <= J) Then
            Y = MyArray(I)
            MyArray(I) = MyArray(J)
            MyArray(J) = Y
            I = I + 1
            J = J - 1
        End If
        gIterations = gIterations + 1
    Wend    If (L < J) Then Call QuickSort(MyArray(), L, J)
    If (I < R) Then Call QuickSort(MyArray(), I, R)End SubSub Selection(MyArray(), ByVal nOrder As Integer)
Dim Index
Dim Min
Dim NextElement
Dim TEMP    NextElement = 0
    While (NextElement < UBound(MyArray))
        Min = UBound(MyArray)
        Index = Min - 1
        While (Index >= NextElement)
            If nOrder = ASCENDING_ORDER Then
                If MyArray(Index) < MyArray(Min) Then
                    Min = Index
                End If
            ElseIf nOrder = DESCENDING_ORDER Then
                If MyArray(Index) >= MyArray(Min) Then
                    Min = Index
                End If
            End If
            Index = Index - 1
            gIterations = gIterations + 1
        Wend
        TEMP = MyArray(Min)
        MyArray(Min) = MyArray(NextElement)
        MyArray(NextElement) = TEMP
        NextElement = NextElement + 1
        gIterations = gIterations - 1
    WendEnd SubSub ShellSort(MyArray(), ByVal nOrder As Integer)
Dim Distance
Dim Size
Dim Index
Dim NextElement
Dim TEMP    Size = UBound(MyArray) - LBound(MyArray) + 1
    Distance = 1    While (Distance <= Size)
        Distance = 2 * Distance
    Wend    Distance = (Distance / 2) - 1
    
    While (Distance > 0)
    
        NextElement = LBound(MyArray) + Distance
    
        While (NextElement <= UBound(MyArray))
            Index = NextElement
            Do
                If Index >= (LBound(MyArray) + Distance) Then
                    If nOrder = ASCENDING_ORDER Then
                        If MyArray(Index) < MyArray(Index - Distance) Then
                            TEMP = MyArray(Index)
                            MyArray(Index) = MyArray(Index - Distance)
                            MyArray(Index - Distance) = TEMP
                            Index = Index - Distance
                            gIterations = gIterations + 1
                        Else
                            Exit Do
                        End If
                    ElseIf nOrder = DESCENDING_ORDER Then
                        If MyArray(Index) >= MyArray(Index - Distance) Then
                            TEMP = MyArray(Index)
                            MyArray(Index) = MyArray(Index - Distance)
                            MyArray(Index - Distance) = TEMP
                            Index = Index - Distance
                            gIterations = gIterations + 1
                        Else
                            Exit Do
                        End If
                    End If
                Else
                    Exit Do
                End If
            Loop
            NextElement = NextElement + 1
            gIterations = gIterations + 1
        Wend
        Distance = (Distance - 1) / 2
        gIterations = gIterations + 1
    Wend
    
End Sub