VBA排序的十种算法.docx
- 文档编号:23103956
- 上传时间:2023-04-30
- 格式:DOCX
- 页数:22
- 大小:85.30KB
VBA排序的十种算法.docx
《VBA排序的十种算法.docx》由会员分享,可在线阅读,更多相关《VBA排序的十种算法.docx(22页珍藏版)》请在冰豆网上搜索。
VBA排序的十种算法
第四种(快速排序)Quicksort
1.PublicSubQuickSort(ByReflngArray()AsLong)
2.DimiLBoundAsLong
3.DimiUBoundAsLong
4.DimiTempAsLong
5.DimiOuterAsLong
6.DimiMaxAsLong
7.
8.iLBound=LBound(lngArray)
9.iUBound=UBound(lngArray)
10.
11.'若只有一个值,不排序
12.If(iUBound-iLBound)Then
13.ForiOuter=iLBoundToiUBound
14.IflngArray(iOuter)>lngArray(iMax)TheniMax=iOuter
15.NextiOuter
16.
17.iTemp=lngArray(iMax)
18.lngArray(iMax)=lngArray(iUBound)
19.lngArray(iUBound)=iTemp
20.
21.'开始快速排序
22.InnerQuickSortlngArray,iLBound,iUBound
23.EndIf
24.EndSub
25.
26.PrivateSubInnerQuickSort(ByReflngArray()AsLong,ByValiLeftEndAsLong,ByValiRightEndAsLong)
27.DimiLeftCurAsLong
28.DimiRightCurAsLong
29.DimiPivotAsLong
30.DimiTempAsLong
31.
32.IfiLeftEnd>=iRightEndThenExitSub
33.
34.iLeftCur=iLeftEnd
35.iRightCur=iRightEnd+1
36.iPivot=lngArray(iLeftEnd)
37.
38.Do
39.Do
40.iLeftCur=iLeftCur+1
41.LoopWhilelngArray(iLeftCur) 42. 43.Do 44.iRightCur=iRightCur-1 45.LoopWhilelngArray(iRightCur)>iPivot 46. 47.IfiLeftCur>=iRightCurThenExitDo 48. 49.'交换值 50.iTemp=lngArray(iLeftCur) 51.lngArray(iLeftCur)=lngArray(iRightCur) 52.lngArray(iRightCur)=iTemp 53.Loop 54. 55.'递归快速排序 56.lngArray(iLeftEnd)=lngArray(iRightCur) 57.lngArray(iRightCur)=iPivot 58. 59.InnerQuickSortlngArray,iLeftEnd,iRightCur-1 60.InnerQuickSortlngArray,iRightCur+1,iRightEnd 61.EndSub 复制代码 第五种(合并排序)Mergesort 1.PublicSubMergeSort(ByReflngArray()AsLong) 2.DimarrTemp()AsLong 3.DimiSegSizeAsLong 4.DimiLBoundAsLong 5.DimiUBoundAsLong 6. 7.iLBound=LBound(lngArray) 8.iUBound=UBound(lngArray) 9. 10.ReDimarrTemp(iLBoundToiUBound) 11. 12.iSegSize=1 13.DoWhileiSegSize 14. 15.'合并A到B 16.InnerMergePasslngArray,arrTemp,iLBound,iUBound,iSegSize 17.iSegSize=iSegSize+iSegSize 18. 19.'合并B到A 20.InnerMergePassarrTemp,lngArray,iLBound,iUBound,iSegSize 21.iSegSize=iSegSize+iSegSize 22. 23.Loop 24.EndSub 25. 26.PrivateSubInnerMergePass(ByReflngSrc()AsLong,ByReflngDest()AsLong,ByValiLBoundAsLong,iUBoundAsLong,ByValiSegSizeAsLong) 27.DimiSegNextAsLong 28. 29.iSegNext=iLBound 30. 31.DoWhileiSegNext<=iUBound-(2*iSegSize) 32.'合并 33.InnerMergelngSrc,lngDest,iSegNext,iSegNext+iSegSize-1,iSegNext+iSegSize+iSegSize-1 34. 35.iSegNext=iSegNext+iSegSize+iSegSize 36.Loop 37. 38.IfiSegNext+iSegSize<=iUBoundThen 39.InnerMergelngSrc,lngDest,iSegNext,iSegNext+iSegSize-1,iUBound 40.Else 41.ForiSegNext=iSegNextToiUBound 42.lngDest(iSegNext)=lngSrc(iSegNext) 43.NextiSegNext 44.EndIf 45. 46.EndSub 47. 48.PrivateSubInnerMerge(ByReflngSrc()AsLong,ByReflngDest()AsLong,ByValiStartFirstAsLong,ByValiEndFirstAsLong,ByValiEndSecondAsLong) 49.DimiFirstAsLong 50.DimiSecondAsLong 51.DimiResultAsLong 52.DimiOuterAsLong 53. 54.iFirst=iStartFirst 55.iSecond=iEndFirst+1 56.iResult=iStartFirst 57. 58.DoWhile(iFirst<=iEndFirst)And(iSecond<=iEndSecond) 59. 60.IflngSrc(iFirst)<=lngSrc(iSecond)Then 61.lngDest(iResult)=lngSrc(iFirst) 62.iFirst=iFirst+1 63.Else 64.lngDest(iResult)=lngSrc(iSecond) 65.iSecond=iSecond+1 66.EndIf 67. 68.iResult=iResult+1 69.Loop 70. 71.IfiFirst>iEndFirstThen 72.ForiOuter=iSecondToiEndSecond 73.lngDest(iResult)=lngSrc(iOuter) 74.iResult=iResult+1 75.NextiOuter 76.Else 77.ForiOuter=iFirstToiEndFirst 78.lngDest(iResult)=lngSrc(iOuter) 79.iResult=iResult+1 80.NextiOuter 81.EndIf 82.EndSub 复制代码 第六种(堆排序)Heapsort 1.PublicSubHeapSort(ByReflngArray()AsLong) 2.DimiLBoundAsLong 3.DimiUBoundAsLong 4.DimiArrSizeAsLong 5.DimiRootAsLong 6.DimiChildAsLong 7.DimiElementAsLong 8.DimiCurrentAsLong 9.DimarrOut()AsLong 10. 11.iLBound=LBound(lngArray) 12.iUBound=UBound(lngArray) 13.iArrSize=iUBound-iLBound 14. 15.ReDimarrOut(iLBoundToiUBound) 16. 17.'Initialisetheheap 18.'Moveuptheheapfromthebottom 19.ForiRoot=iArrSize\2To0Step-1 20. 21.iElement=lngArray(iRoot+iLBound) 22.iChild=iRoot+iRoot 23. 24.'Movedowntheheapfromthecurrentposition 25.DoWhileiChild 26. 27.IfiChild 28.IflngArray(iChild+iLBound) 29.'Alwayswantlargestchild 30.iChild=iChild+1 31.EndIf 32.EndIf 33. 34.'Foundaslot,stoplooking 35.IfiElement>=lngArray(iChild+iLBound)ThenExitDo 36. 37.lngArray((iChild\2)+iLBound)=lngArray(iChild+iLBound) 38.iChild=iChild+iChild 39.Loop 40. 41.'Movethenode 42.lngArray((iChild\2)+iLBound)=iElement 43.NextiRoot 44. 45.'Readofvaluesonebyone(storeinarraystartingattheend) 46.ForiRoot=iUBoundToiLBoundStep-1 47. 48.'Readthevalue 49.arrOut(iRoot)=lngArray(iLBound) 50.'Getthelastelement 51.iElement=lngArray(iArrSize+iLBound) 52. 53.iArrSize=iArrSize-1 54.iCurrent=0 55.iChild=1 56. 57.'Findaplaceforthelastelementtogo 58.DoWhileiChild<=iArrSize 59. 60.IfiChild 61.IflngArray(iChild+iLBound) 62.'Alwayswantthelargerchild 63.iChild=iChild+1 64.EndIf 65.EndIf 66. 67.'Foundaposition 68.IfiElement>=lngArray(iChild+iLBound)ThenExitDo 69. 70.lngArray(iCurrent+iLBound)=lngArray(iChild+iLBound) 71.iCurrent=iChild 72.iChild=iChild+iChild 73. 74.Loop 75. 76.'Movethenode 77.lngArray(iCurrent+iLBound)=iElement 78.NextiRoot 79. 80.'Copyfromtemparraytorealarray 81.ForiRoot=iLBoundToiUBound 82.lngArray(iRoot)=arrOut(iRoot) 83.NextiRoot 84.EndSub 复制代码 第七种(组合排序)CombSort 1.PublicSubCombSort(ByReflngArray()AsLong) 2.DimiSpacingAsLong 3.DimiOuterAsLong 4.DimiInnerAsLong 5.DimiTempAsLong 6.DimiLBoundAsLong 7.DimiUBoundAsLong 8.DimiArrSizeAsLong 9.DimiFinishedAsLong 10. 11.iLBound=LBound(lngArray) 12.iUBound=UBound(lngArray) 13. 14.'Initialisecombwidth 15.iSpacing=iUBound-iLBound 16. 17.Do 18.IfiSpacing>1Then 19.iSpacing=Int(iSpacing/1.3) 20. 21.IfiSpacing=0Then 22.iSpacing=1'Dontgolowerthan1 23.ElseIfiSpacing>8AndiSpacing<11Then 24.iSpacing=11'Thisisaspecialnumber,goesfasterthan9and10 25.EndIf 26.EndIf 27. 28.'Alwaysgodownto1beforeattemptingtoexit 29.IfiSpacing=1TheniFinished=1 30. 31.'Combingpass 32.ForiOuter=iLBoundToiUBound-iSpacing 33.iInner=iOuter+iSpacing 34. 35.IflngArray(iOuter)>lngArray(iInner)Then 36.'Swap 37.iTemp=lngArray(iOuter) 38.lngArray(iOuter)=lngArray(iInner) 39.lngArray(iInner)=iTemp 40. 41.'Notfinished 42.iFinished=0 43.EndIf 44.NextiOuter 45. 46.LoopUntiliFinished 47.EndSub 复制代码 第八种(希尔排序)ShellSort 1.PublicSubShellSort(ByReflngArray()AsLong) 2.DimiSpacingAsLong 3.DimiOuterAsLong 4.DimiInnerAsLong 5.DimiTempAsLong 6.DimiLBoundAsLong 7.DimiUBoundAsLong 8.DimiArrSizeAsLong 9. 10.iLBound=LBound(lngArray) 11.iUBound=UBound(lngArray) 12. 13.'Calculateinitialsortspacing 14.iArrSize=(iUBound-iLBound)+1 15.iSpacing=1 16. 17.IfiArrSize>13Then 18.DoWhileiSpacing 19.iSpacing=(3*iSpacing)+1 20.Loop 21. 22.iSpacing=iSpacing\9 23.EndIf 24. 25.'Startsorting 26.DoWhileiSpacing 27. 28.ForiOuter=iLBound+iSpacingToiUBound 29. 30.'Getthevaluetobeinserted 31.iTemp=lngArray(iOuter) 32. 33.'Movealongthealreadysortedvaluesshiftingalong 34.ForiInner=iOuter-iSpacingToiLBoundStep-iSpacing 35.'Nomoreshiftingneeded,wefoundtherightspot! 36.IflngArray(iInner)<=iTempThenExitFor 37. 38.lngArray(iInner+iSpacing)=lngArray(iInner) 39.NextiInner 40. 41.'Insertvalueintheslot 42.lngArray(iInner+iSpacing)=iTemp 43.NextiOuter 44. 45.'Reducethesortspacing 46.iSpacing=iSpacing\3 47.Loop 48. 49.EndSub 复制代码 第九种(基数排序)RadixSort 1.PublicSubRadixSort(ByReflngArray()AsLong) 2.DimarrTemp()AsLong 3.DimiLBoundAsLong 4.DimiUBoundAsLong 5.DimiMaxAsLong 6.DimiSortsAsLong 7.DimiLoopAsLong 8. 9.iLBound=LBound(lngArray) 10.iUBound=UBound(lngArray) 11. 12.'Createswaparray 13.ReDimarrTemp(iLBoundToiUBound) 14. 15.iMax=&H80000000 16.'Findlargest 17.ForiLoop=iLBoundToiUBound 18.IflngArray(iLoop)>iMaxTheniMax=lngArray(iLoop) 19.NextiLoop 20. 21.'Calculatehowmanysortsareneeded 22.DoWhileiMax 23.iSorts=iSorts+1 24.iMax=iMax\256 25.Loop 26. 27.iMax=1 28. 29.'Dothesorts 30.ForiLoop=1ToiSorts 31. 32.IfiLoopAnd1Then 33.'Oddsort->srctodest 34.InnerRadixSortlngArray,arrTemp,iLBound,iUBound,iMax 35.Else 36.'Evensort->desttosrc 37.InnerRadixSortarrTemp,lngArray,iLBound,iUBound,iMax 38.EndIf 39. 40.'Nextsortfactor 41.iMax=iMax*256 42.NextiLoop 43. 44.'Ifoddnumberofsortsweneedtoswapthearrays 45.If(iSortsAnd1)Then 46.ForiLoop=iLBoundToiUBound 47.lngArray(iLoop)=arrTemp(iLoop) 48.NextiLoop 49.EndIf 50.EndSub 51. 52.PrivateSubInnerRadixSort(ByReflngSrc()AsLong,ByReflngDest()AsLong,ByValiLBoundAsLong,ByValiUBoundAsLong,ByValiDivisorAsLong) 53.DimarrCounts(255)AsLong 54.DimarrOffsets(255)AsLong 55.DimiBucketAsLong 56.DimiLoopAsLong 57. 58.'Counttheitemsforeachbucket 59.ForiLoop=iLBoundToiUBound 60.iBucket=(lngSrc(iLoop)\iDivisor)And255 61.arrCounts(iBucket)=arrCounts(iBucket)+1 62.NextiLoop 63. 64.'Generateoffsets 65.ForiLoop=1To255 66.arrOffsets(iLoop)=arrOff
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- VBA 排序 算法