合并排序.doc

Public Sub MergeSort(ByRef lngArray() As Long)
    Dim arrTemp() As Long
    Dim iSegSize As Long
    Dim iLBound As Long
    Dim iUBound As Long

    iLBound = LBound(lngArray)
    iUBound = UBound(lngArray)

    ReDim arrTemp(iLBound To iUBound)

    iSegSize = 1
    Do While iSegSize < iUBound - iLBound

        '合并A到B
        InnerMergePass lngArray, arrTemp, iLBound, iUBound, iSegSize
        iSegSize = iSegSize + iSegSize

        '合并B到A
        InnerMergePass arrTemp, lngArray, iLBound, iUBound, iSegSize
        iSegSize = iSegSize + iSegSize

    Loop
End Sub
Private Sub InnerMergePass(ByRef lngSrc() As Long, ByRef lngDest() As Long, ByVal iLBound As Long, iUBound As Long, ByVal iSegSize As Long)
    Dim iSegNext As Long

    iSegNext = iLBound

    Do While iSegNext <= iUBound - (2 * iSegSize)
        '合并
        InnerMerge lngSrc, lngDest, iSegNext, iSegNext + iSegSize - 1, iSegNext + iSegSize + iSegSize - 1

        iSegNext = iSegNext + iSegSize + iSegSize
    Loop

    If iSegNext + iSegSize <= iUBound Then
        InnerMerge lngSrc, lngDest, iSegNext, iSegNext + iSegSize - 1, iUBound
    Else
        For iSegNext = iSegNext To iUBound
            lngDest(iSegNext) = lngSrc(iSegNext)
        Next iSegNext
    End If
End Sub
Private Sub InnerMerge(ByRef lngSrc() As Long, ByRef lngDest() As Long, ByVal iStartFirst As Long, ByVal iEndFirst As Long, ByVal iEndSecond As Long)
    Dim iFirst As Long
    Dim iSecond As Long
    Dim iResult As Long
    Dim iOuter As Long

    iFirst = iStartFirst
    iSecond = iEndFirst + 1
    iResult = iStartFirst

    Do While (iFirst <= iEndFirst) And (iSecond <= iEndSecond)

        If lngSrc(iFirst) <= lngSrc(iSecond) Then
            lngDest(iResult) = lngSrc(iFirst)
            iFirst = iFirst + 1
        Else
            lngDest(iResult) = lngSrc(iSecond)
            iSecond = iSecond + 1
        End If

        iResult = iResult + 1
    Loop

    If iFirst > iEndFirst Then
        For iOuter = iSecond To iEndSecond
            lngDest(iResult) = lngSrc(iOuter)
            iResult = iResult + 1
        Next iOuter
    Else
        For iOuter = iFirst To iEndFirst
            lngDest(iResult) = lngSrc(iOuter)
            iResult = iResult + 1
        Next iOuter
    End If
End Sub