《Ecel VBA排序典型算法》由会员分享，可在线阅读，更多相关《Ecel VBA排序典型算法（9页珍藏版）》请在金锄头文库上搜索。
1、1. 冒泡排序Public Sub BubbleSort(ByRef lngArray() As Long)Dim iOuter As LongDim iInner As LongDim iLBound As LongDim iUBound As LongDim iTemp As LongiLBound = LBound(lngArray)iUBound = UBound(lngArray)冒泡排序For iOuter = iLBound To iUBound - 1For iInner = iLBound To iUBound iOuter 1比较相邻项If lngArray(ilnner)
2、 lngArray(iInner + 1) Then交换值iTemp = lngArray(ilnner)lngArray(ilnner) = lngArray(iInner + 1)lngArray(iInner + 1) = iTempEnd IfNext iInnerNext iOuterEnd Sub2、选择排序1. Public Sub SelectionSort(ByRef lngArray() As Long)2. Dim iOuter As Long3. Dim iInner As Long4. Dim iLBound As Long5. Dim iUBound As Long
3、6. Dim iTemp As Long7. Dim iMax As Long8.8. iLBound = LBound(lngArray)9. iUBound = UBound(lngArray)11.10. 选择排序11. For iOuter = iUBound To iLBound + 1 Step -114.12. iMax = 016.13. 得到最大值得索引14. For iInner = iLBound To iOuter15. If lngArray(iInner) lngArray(iMax) Then iMax = iInner16. Next iInner21.17.
4、值交换18. iTemp = lngArray(iMax)19. lngArray(iMax) = lngArray(iOuter)20. lngArray(iOuter) = iTemp26.21. Next iOuter22. End Sub3. 插入排序1. Public Sub InsertionSort(ByRef lngArray() As Long)2. Dim iOuter As Long3. Dim iInner As Long4. Dim iLBound As Long5. Dim iUBound As Long6. Dim iTemp As Long7.8. iLBoun
5、d = LBound(lngArray)9. iUBound = UBound(lngArray)10.10. For iOuter = iLBound + 1 To iUBound12.11. 取得插入值12. iTemp = lngArray(iOuter)15.13. 移动已经排序的值14. For iInner = iOuter - 1 To iLBound Step -115. If lngArray(iInner) lngArray(iMax) Then iMax = iOuter13. Next iOuter16.14. iTemp = lngArray(iMax)15. lng
6、Array(iMax) = lngArray(iUBound)16. lngArray(iUBound) = iTemp20.17. 开始快速排序18. InnerQuickSort lngArray, iLBound, iUBound19. End If20. End Sub25.21. Private Sub InnerQuickSort(ByRef lngArray() As Long, ByVal iLeftEnd As Long, ByVal iRightEnd As Long)22. Dim iLeftCur As Long23. Dim iRightCur As Long24.
7、Dim iPivot As Long25. Dim iTemp As Long31.26. If iLeftEnd = iRightEnd Then Exit Sub33.27. iLeftCur = iLeftEnd28. iRightCur = iRightEnd + 129. iPivot = lngArray(iLeftEnd)37.30. Do31. Do32. iLeftCur = iLeftCur + 133. Loop While lngArray(iLeftCur) iPivot46.37. If iLeftCur = iRightCur Then Exit Do48.38.
8、 交换值39. iTemp = lngArray(iLeftCur)40. lngArray(iLeftCur) = lngArray(iRightCur)41. lngArray(iRightCur) = iTemp42. Loop54.43. 递归快速排序44. lngArray(iLeftEnd) = lngArray(iRightCur)45. lngArray(iRightCur) = iPivot58.46. InnerQuickSort lngArray, iLeftEnd, iRightCur - 147. InnerQuickSort lngArray, iRightCur
9、+ 1, iRightEnd48. End Sub5. 合并排序1. Public Sub MergeSort(ByRef lngArray() As Long)2. Dim arrTemp() As Long3. Dim iSegSize As Long4. Dim iLBound As Long5. Dim iUBound As Long6.6. iLBound = LBound(lngArray)7. iUBound = UBound(lngArray)9.8. ReDim arrTemp(iLBound To iUBound)11.9. iSegSize = 110. Do While
10、 iSegSize iUBound - iLBound14.11. 合并A到B12. InnerMergePass lngArray, arrTemp, iLBound, iUBound, iSegSize13. iSegSize = iSegSize + iSegSize18.14. 合并B到A15. InnerMergePass arrTemp, lngArray, iLBound, iUBound, iSegSize16. iSegSize = iSegSize + iSegSize22.17. Loop18. End Sub25.19. Private Sub InnerMergePa
11、ss(ByRef lngSrc() As Long, ByRef lngDest() As Long, ByValiLBound As Long, iUBound As Long, ByVal iSegSize As Long)20. Dim iSegNext As Long28.21. iSegNext = iLBound30.22. Do While iSegNext = iUBound - (2 * iSegSize)23. 合并24. InnerMerge lngSrc, lngDest, iSegNext, iSegNext + iSegSize - 1, iSegNext + iS
12、egSize+ iSegSize - 134.25. iSegNext = iSegNext + iSegSize + iSegSize26. Loop 37.38. If iSegNext + iSegSize = iUBound Then39. InnerMerge lngSrc, lngDest, iSegNext, iSegNext + iSegSize - 1, iUBound40. Else41. For iSegNext = iSegNext To iUBound42. lngDest(iSegNext) = lngSrc(iSegNext)43. Next iSegNext44
13、. End If45.45. End Sub47.46. Private Sub InnerMerge(ByRef lngSrc() As Long, ByRef lngDest() As Long, ByVal iStartFirst As Long, ByVal iEndFirst As Long, ByVal iEndSecond As Long)47. Dim iFirst As Long48. Dim iSecond As Long49. Dim iResult As Long50. Dim iOuter As Long53.51. iFirst = iStartFirst52. iSecond = iEndFirst + 153. iResult = iStartFirst57.54. Do While (iFirst = iEndFirst) And (iSeco
