vba排序的十种算法.docx

在使用 VBA 进行写程序时，经常会做排序，下面将会给出一些常用的排序算法的实现，方便大家写程序参考，若代码中出现了错误，欢迎高手指正主要算法有：1、 （冒泡排序）Bubble sort2、 （选择排序）Selection sort3、 （插入排序）Insertion sort4、 （快速排序）Quick sort5、 （合并排序）Merge sort6、 （堆排序）Heap sort7、 （组合排序）Comb Sort8、 （希尔排序）Shell Sort9、 （基数排序）Radix Sort10、 Shaker Sort第一种 （冒泡排序）Bubble sortPublic 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(iInner) > lngArray(iInner + 1) Then'交换值iTemp = lngArray(iInner)lngArray(iInner) = lngArray(iInner + 1)lngArray(iInner + 1) = iTempEnd If Next iInnerNext 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 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 iInner21.22. '值交换23. iTemp = lngArray(iMax)24. lngArray(iMax) = lngArray(iOuter)25. lngArray(iOuter) = iTemp26.27. Next iOuter28. End Sub复制代码第三种 （插入排序）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. 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. '移动已经排序的值17. For iInner = iOuter - 1 To iLBound Step -118. If lngArray(iInner) lngArray(iMax) Then iMax = iOuter15. Next iOuter16.17. 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 Long28. 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 >= 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. InnerQuickSort lngArray, iRightCur + 1, iRightEnd61. End Sub复制代码第五种 （合并排序）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(iLBound To iUBound)11.12. iSegSize = 113. Do While iSegSize iEndFirst Then72. For iOuter = iSecond To iEndSecond73. lngDest(iResult) = lngSrc(iOuter)74. iResult = iResult + 175. Next iOuter76. Else77. For iOuter = iFirst To iEndFirst78. lngDest(iResult) = lngSrc(iOuter)79. iResult = iResult + 180. Next iOuter81. End If82. End Sub复制代码第六种 （堆排序）Heap sort1. Public Sub HeapSort(ByRef lngArray() As Long)2. Dim iLBound As Long3. Dim iUBound As Long4. Dim iArrSize As Long5. Dim iRoot 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. 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 = lngArray(iChild + iLBound) Then Exit Do36.37. lngArray((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 value49. 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 = 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 iRoot = iLBound To iUBound82. lngArray(iRoot) = arrOut(iRoot)83. Next iRoot84. End Sub复制代码第七种 （组合排序）Comb 。