1、在使用VBA進行寫程序時，經(jīng)常會做排序，下面將會給出一些常用的排序算法的實現(xiàn)，方便大家寫程序參考，若代碼中出現(xiàn)了錯誤，歡迎高手指正。主要算法有：1、（冒泡排序）Bubble sort2、（選擇排序）Selection sort3、（插入排序）Insertion sort4、（快速排序）Quick sort5、（合并排序）Merge sort6、（堆排序）Heap sort7、（組合排序）Comb Sort8、（希爾排序）Shell Sort9、（基數(shù)排序）Radix Sort10、Shaker Sort第一種 （冒泡排序）Bubble sortPublic Sub BubbleSort(ByR

2、ef 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 To iUBound - 1 For iInner = iLBound To iUBound - iOuter - 1 比較相鄰項 If lngArray(iInner) lngArray(iInner

3、 + 1) Then 交換值 iTemp = lngArray(iInner) lngArray(iInner) = lngArray(iInner + 1) lngArray(iInner + 1) = iTemp End If Next iInner Next iOuterEnd Sub2、（選擇排序）Selection sort1. Public Sub SelectionSort(ByRef lngArray() As Long)2. Dim iOuter As Long3. Dim iInner As Long4. Dim iLBound As Long5. Dim iUBound

4、As Long6. Dim iTemp As Long7. Dim iMax As Long8.9. iLBound = LBound(lngArray)10. iUBound = UBound(lngArray)11.12. 選擇排序13. For iOuter = iUBound To iLBound + 1 Step -114.15. iMax = 016.17. 得到最大值得索引18. For iInner = iLBound To iOuter19. If lngArray(iInner) lngArray(iMax) Then iMax = iInner20. Next iInne

5、r21.22. 值交換23. iTemp = lngArray(iMax)24. lngArray(iMax) = lngArray(iOuter)25. lngArray(iOuter) = iTemp26.27. Next iOuter28. End Sub復(fù)制代碼第三種 （插入排序）Insertion sort1. Public Sub InsertionSort(ByRef lngArray() As Long)2. Dim iOuter As Long3. Dim iInner As Long4. Dim iLBound As Long5. Dim iUBound As Long6.

6、 Dim iTemp As Long7.8. iLBound = LBound(lngArray)9. iUBound = UBound(lngArray)10.11. For iOuter = iLBound + 1 To iUBound12.13. 取得插入值14. iTemp = lngArray(iOuter)15.16. 移動已經(jīng)排序的值17. For iInner = iOuter - 1 To iLBound Step -118. If lngArray(iInner) lngArray(iMax) Then iMax = iOuter15. Next iOuter16.17.

7、iTemp = lngArray(iMax)18. lngArray(iMax) = lngArray(iUBound)19. lngArray(iUBound) = iTemp20.21. 開始快速排序22. InnerQuickSort lngArray, iLBound, iUBound23. End If24. End Sub25.26. Private Sub InnerQuickSort(ByRef lngArray() As Long, ByVal iLeftEnd As Long, ByVal iRightEnd As Long)27. Dim iLeftCur As Long

8、28. Dim iRightCur As Long29. Dim iPivot As Long30. Dim iTemp As Long31.32. If iLeftEnd = iRightEnd Then Exit Sub33.34. iLeftCur = iLeftEnd35. iRightCur = iRightEnd + 136. iPivot = lngArray(iLeftEnd)37.38. Do39. Do40. iLeftCur = iLeftCur + 141. Loop While lngArray(iLeftCur) iPivot46.47. If iLeftCur =

9、 iRightCur Then Exit Do48.49. 交換值50. iTemp = lngArray(iLeftCur)51. lngArray(iLeftCur) = lngArray(iRightCur)52. lngArray(iRightCur) = iTemp53. Loop54.55. 遞歸快速排序56. lngArray(iLeftEnd) = lngArray(iRightCur)57. lngArray(iRightCur) = iPivot58.59. InnerQuickSort lngArray, iLeftEnd, iRightCur - 160. InnerQ

10、uickSort lngArray, iRightCur + 1, iRightEnd61. End Sub復(fù)制代碼第五種 （合并排序）Merge sort1. Public Sub MergeSort(ByRef lngArray() As Long)2. Dim arrTemp() As Long3. Dim iSegSize As Long4. Dim iLBound As Long5. Dim iUBound As Long6.7. iLBound = LBound(lngArray)8. iUBound = UBound(lngArray)9.10. ReDim arrTemp(iL

11、Bound To iUBound)11.12. iSegSize = 113. Do While iSegSize iUBound - iLBound14.15. 合并A到B16. InnerMergePass lngArray, arrTemp, iLBound, iUBound, iSegSize17. iSegSize = iSegSize + iSegSize18.19. 合并B到A20. InnerMergePass arrTemp, lngArray, iLBound, iUBound, iSegSize21. iSegSize = iSegSize + iSegSize22.23

12、. Loop24. End Sub25.26. Private Sub InnerMergePass(ByRef lngSrc() As Long, ByRef lngDest() As Long, ByVal iLBound As Long, iUBound As Long, ByVal iSegSize As Long)27. Dim iSegNext As Long28.29. iSegNext = iLBound30.31. Do While iSegNext = iUBound - (2 * iSegSize)32. 合并33. InnerMerge lngSrc, lngDest,

13、 iSegNext, iSegNext + iSegSize - 1, iSegNext + iSegSize + iSegSize - 134.35. iSegNext = iSegNext + iSegSize + iSegSize36. Loop37.38. If iSegNext + iSegSize = iUBound Then39. InnerMerge lngSrc, lngDest, iSegNext, iSegNext + iSegSize - 1, iUBound40. Else41. For iSegNext = iSegNext To iUBound42. lngDes

14、t(iSegNext) = lngSrc(iSegNext)43. Next iSegNext44. End If45.46. End Sub47.48. Private Sub InnerMerge(ByRef lngSrc() As Long, ByRef lngDest() As Long, ByVal iStartFirst As Long, ByVal iEndFirst As Long, ByVal iEndSecond As Long)49. Dim iFirst As Long50. Dim iSecond As Long51. Dim iResult As Long52. D

15、im iOuter As Long53.54. iFirst = iStartFirst55. iSecond = iEndFirst + 156. iResult = iStartFirst57.58. Do While (iFirst = iEndFirst) And (iSecond = iEndSecond)59.60. If lngSrc(iFirst) iEndFirst Then72. For iOuter = iSecond To iEndSecond73. lngDest(iResult) = lngSrc(iOuter)74. iResult = iResult + 175

16、. Next iOuter76. Else77. For iOuter = iFirst To iEndFirst78. lngDest(iResult) = lngSrc(iOuter)79. iResult = iResult + 180. Next iOuter81. End If82. End Sub復(fù)制代碼第六種 （堆排序）Heap sort1. Public Sub HeapSort(ByRef lngArray() As Long)2. Dim iLBound As Long3. Dim iUBound As Long4. Dim iArrSize As Long5. Dim i

17、Root As Long6. Dim iChild As Long7. Dim iElement As Long8. Dim iCurrent As Long9. Dim arrOut() As Long10.11. iLBound = LBound(lngArray)12. iUBound = UBound(lngArray)13. iArrSize = iUBound - iLBound14.15. ReDim arrOut(iLBound To iUBound)16.17. Initialise the heap18. Move up the heap from the bottom19

18、. For iRoot = iArrSize 2 To 0 Step -120.21. iElement = lngArray(iRoot + iLBound)22. iChild = iRoot + iRoot23.24. Move down the heap from the current position25. Do While iChild iArrSize26.27. If iChild iArrSize Then28. If lngArray(iChild + iLBound) = lngArray(iChild + iLBound) Then Exit Do36.37. lng

19、Array(iChild 2) + iLBound) = lngArray(iChild + iLBound)38. iChild = iChild + iChild39. Loop40.41. Move the node42. lngArray(iChild 2) + iLBound) = iElement43. Next iRoot44.45. Read of values one by one (store in array starting at the end)46. For iRoot = iUBound To iLBound Step -147.48. Read the valu

20、e49. arrOut(iRoot) = lngArray(iLBound)50. Get the last element51. iElement = lngArray(iArrSize + iLBound)52.53. iArrSize = iArrSize - 154. iCurrent = 055. iChild = 156.57. Find a place for the last element to go58. Do While iChild = iArrSize59.60. If iChild iArrSize Then61. If lngArray(iChild + iLBo

21、und) = lngArray(iChild + iLBound) Then Exit Do69.70. lngArray(iCurrent + iLBound) = lngArray(iChild + iLBound)71. iCurrent = iChild72. iChild = iChild + iChild73.74. Loop75.76. Move the node77. lngArray(iCurrent + iLBound) = iElement78. Next iRoot79.80. Copy from temp array to real array81. For iRoo

22、t = iLBound To iUBound82. lngArray(iRoot) = arrOut(iRoot)83. Next iRoot84. End Sub復(fù)制代碼第七種 （組合排序）Comb Sort1. Public Sub CombSort(ByRef lngArray() As Long)2. Dim iSpacing As Long3. Dim iOuter As Long4. Dim iInner As Long5. Dim iTemp As Long6. Dim iLBound As Long7. Dim iUBound As Long8. Dim iArrSize As

23、 Long9. Dim iFinished As Long10.11. iLBound = LBound(lngArray)12. iUBound = UBound(lngArray)13.14. Initialise comb width15. iSpacing = iUBound - iLBound16.17. Do18. If iSpacing 1 Then19. iSpacing = Int(iSpacing / 1.3)20.21. If iSpacing = 0 Then22. iSpacing = 1 Dont go lower than 123. ElseIf iSpacing

24、 8 And iSpacing lngArray(iInner) Then36. Swap37. iTemp = lngArray(iOuter)38. lngArray(iOuter) = lngArray(iInner)39. lngArray(iInner) = iTemp40.41. Not finished42. iFinished = 043. End If44. Next iOuter45.46. Loop Until iFinished47. End Sub復(fù)制代碼第八種 （希爾排序）Shell Sort1. Public Sub ShellSort(ByRef lngArra

25、y() As Long)2. Dim iSpacing As Long3. Dim iOuter As Long4. Dim iInner As Long5. Dim iTemp As Long6. Dim iLBound As Long7. Dim iUBound As Long8. Dim iArrSize As Long9.10. iLBound = LBound(lngArray)11. iUBound = UBound(lngArray)12.13. Calculate initial sort spacing14. iArrSize = (iUBound - iLBound) +

26、115. iSpacing = 116.17. If iArrSize 13 Then18. Do While iSpacing iArrSize19. iSpacing = (3 * iSpacing) + 120. Loop21.22. iSpacing = iSpacing 923. End If24.25. Start sorting26. Do While iSpacing27.28. For iOuter = iLBound + iSpacing To iUBound29.30. Get the value to be inserted31. iTemp = lngArray(iO

27、uter)32.33. Move along the already sorted values shifting along34. For iInner = iOuter - iSpacing To iLBound Step -iSpacing35. No more shifting needed, we found the right spot!36. If lngArray(iInner) iMax Then iMax = lngArray(iLoop)19. Next iLoop20.21. Calculate how many sorts are needed22. Do While

28、 iMax23. iSorts = iSorts + 124. iMax = iMax 25625. Loop26.27. iMax = 128.29. Do the sorts30. For iLoop = 1 To iSorts31.32. If iLoop And 1 Then33. Odd sort - src to dest34. InnerRadixSort lngArray, arrTemp, iLBound, iUBound, iMax35. Else36. Even sort - dest to src37. InnerRadixSort arrTemp, lngArray,

29、 iLBound, iUBound, iMax38. End If39.40. Next sort factor41. iMax = iMax * 25642. Next iLoop43.44. If odd number of sorts we need to swap the arrays45. If (iSorts And 1) Then46. For iLoop = iLBound To iUBound47. lngArray(iLoop) = arrTemp(iLoop)48. Next iLoop49. End If50. End Sub51.52. Private Sub Inn

30、erRadixSort(ByRef lngSrc() As Long, ByRef lngDest() As Long, ByVal iLBound As Long, ByVal iUBound As Long, ByVal iDivisor As Long)53. Dim arrCounts(255) As Long54. Dim arrOffsets(255) As Long55. Dim iBucket As Long56. Dim iLoop As Long57.58. Count the items for each bucket59. For iLoop = iLBound To iUBound60. iBucket = (lngSrc(iLoop) iDivisor) And 25561. arrCounts(iBucket) = arrCounts(iBucket) + 162. Next iLoop63.64. Generate offsets65. For iLoop = 1 To 25566. arrOffsets(iLoop) = arrOffsets(iLoop - 1) + arrCounts(iLoop - 1) + iLBound67. Next iLoop68.69. Fill t