www.51vba/show.aspx?page=1&id=3986&cid=44
VBA排序的10种方法（冒泡，选择等）
[日期：2011-08-07] 
使用VBA进行写程序时，经常会做排序，下面将会给出一些常用的排序算法的实现，方便大家写程序参考，若代码中出现了错误，欢迎高手指正。
主要算法有：
1、（冒泡排序）Bubble sort
2、（选择排序）Selection sort
3、（插入排序）Insertion sort
4、（快速排序）Quick sort
5、（合并排序）Merge sort
6、（堆排序）Heap sort
7、（组合排序）Comb Sort
8、（希尔排序）Shell Sort
9、（基数排序）Radix Sort
10、Shaker Sort
后面会陆续给出这十种算法的实现
1 冒泡排序
Public Sub BubbleSort(ByRef lngArray() As Long)
    Dim iOuter As Long
    Dim iInner As Long
    Dim iLBound As Long
    Dim iUBound As Long
    Dim iTemp As Long
    iLBound = LBound(lngArray)
vba排序函数sort用法
    iUBound = UBound(lngArray)
    '冒泡排序
    For iOuter = iLBound To iUBound - 1
        For iInner = iLBound To iUBound - iOuter - 1
            '比较相邻项
            If lngArray(iInner) > lngArray(iInner + 1) Then
                '交换值
                iTemp = lngArray(iInner)
                lngArray(iInner) = lngArray(iInner + 1)
                lngArray(iInner + 1) = iTemp
            End If
        Next iInner
    Next iOuter
End Sub
2 选择排序
Public Sub SelectionSort(ByRef lngArray() As Long)
    Dim iOuter As Long
    Dim iInner As Long
    Dim iLBound As Long
    Dim iUBound As Long
    Dim iTemp As Long
    Dim iMax As Long
    iLBound = LBound(lngArray)
    iUBound = UBound(lngArray)
    '选择排序
    For iOuter = iUBound To iLBound + 1 Step -1
        iMax = 0
        '得到最大值得索引
        For iInner = iLBound To iOuter
            If lngArray(iInner) > lngArray(iMax) Then iMax = iInner
        Next iInner
        '值交换
        iTemp = lngArray(iMax)
        lngArray(iMax) = lngArray(iOuter)
        lngArray(iOuter) = iTemp
    Next iOuter
End Sub
3 插入排序
Public Sub InsertionSort(ByRef lngArray() As Long)
    Dim iOuter As Long
    Dim iInner As Long
    Dim iLBound As Long
    Dim iUBound As Long
    Dim iTemp As Long
   
    iLBound = LBound(lngArray)
    iUBound = UBound(lngArray)
   
    For iOuter = iLBound + 1 To iUBound
       
        '取得插入值
        iTemp = lngArray(iOuter)
       
        '移动已经排序的值
        For iInner = iOuter - 1 To iLBound Step -1
            If lngArray(iInner) <= iTemp Then Exit For
            lngArray(iInner + 1) = lngArray(iInner)
        Next iInner
       
        '插入值
        lngArray(iInner + 1) = iTemp
    Next iOuter
End Sub
4 快速排序
Public Sub QuickSort(ByRef lngArray() As Long)
Dim iLBound As Long
Dim iUBound As Long
Dim iTemp As Long
Dim iOuter As Long
Dim iMax As Long
    iLBound = LBound(lngArray)
iUBound = UBound(lngArray)
    '若只有一个值，不排序
    If (iUBound - iLBound) Then
For iOuter = iLBound To iUBound
            If lngArray(iOuter) > lngArray(iMax) Then iMax = iOuter
        Next iOuter
       
        iTemp = lngArray(iMax)
        lngArray(iMax) = lngArray(iUBound)
        lngArray(iUBound) = iTemp
   
        '开始快速排序
        InnerQuickSort lngArray, iLBound, iUBound
    End If
End Sub
Private Sub InnerQuickSort(ByRef lngArray() As Long, ByVal iLeftEnd As Long, ByVal iRightEnd As Long)
    Dim iLeftCur As Long
    Dim iRightCur As Long
    Dim iPivot As Long
    Dim iTemp As Long
   
    If iLeftEnd >= iRightEnd Then Exit Sub
   
    iLeftCur = iLeftEnd
    iRightCur = iRightEnd + 1
    iPivot = lngArray(iLeftEnd)
   
    Do
        Do
            iLeftCur = iLeftCur + 1
        Loop While lngArray(iLeftCur) < iPivot
       
        Do
            iRightCur = iRightCur - 1
        Loop While lngArray(iRightCur) > iPivot
       
        If iLeftCur >= iRightCur Then Exit Do
       
        '交换值
        iTemp = lngArray(iLeftCur)
        lngArray(iLeftCur) = lngArray(iRightCur)
        lngArray(iRightCur) = iTemp
    Loop
   
    '递归快速排序
    lngArray(iLeftEnd) = lngArray(iRightCur)
    lngArray(iRightCur) = iPivot
   
    InnerQuickSort lngArray, iLeftEnd, iRightCur - 1
    InnerQuickSort lngArray, iRightCur + 1, iRightEnd
End Sub
5 合并排序
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

版权声明：本站内容均来自互联网，仅供演示用，请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系QQ:729038198，我们将在24小时内删除。