VBA排序的十种算法.docx
- 文档编号:16753831
- 上传时间:2023-07-17
- 格式:DOCX
- 页数:21
- 大小:19.41KB
VBA排序的十种算法.docx
《VBA排序的十种算法.docx》由会员分享,可在线阅读,更多相关《VBA排序的十种算法.docx(21页珍藏版)》请在冰点文库上搜索。
VBA排序的十种算法
进行写程序时,经常会做排序,下面将会给出一些常用的排序算法的实现,方VBA在使用便大家写程序参考,若代码中出现了错误,欢迎高手指正。
主要算法有:
Bubblesort1、(冒泡排序)Selectionsort、(选择排序)2Insertionsort、(插入排序)3(快速排序)、Quicksort4(合并排序)Mergesort5、(堆排序)Heapsort6、(组合排序)CombSort7、ShellSort8、(希尔排序)RadixSort9、(基数排序)ShakerSort10、Bubblesort
(冒泡排序)第一种PublicSubBubbleSort(ByReflngArray()AsLong)
DimiOuterAsLong
DimiInnerAsLong
DimiLBoundAsLong
DimiUBoundAsLong
DimiTempAsLong
iLBound=LBound(lngArray)
iUBound=UBound(lngArray)
'冒泡排序
ForiOuter=iLBoundToiUBound-1
ForiInner=iLBoundToiUBound-iOuter-1
'比较相邻项
IflngArray(iInner)>lngArray(iInner+1)Then
'交换值
iTemp=lngArray(iInner)
lngArray(iInner)=lngArray(iInner+1)
lngArray(iInner+1)=iTemp
EndIf
NextiInner
NextiOuter
EndSub
Selectionsort
、(选择排序)21.PublicSubSelectionSort(ByReflngArray()AsLong)
2.DimiOuterAsLong
3.DimiInnerAsLong
4.DimiLBoundAsLong
5.DimiUBoundAsLong
6.DimiTempAsLong
7.DimiMaxAsLong
8.
9.iLBound=LBound(lngArray)
10.iUBound=UBound(lngArray)
11.
12.'选择排序
13.ForiOuter=iUBoundToiLBound+1Step-1
14.
15.iMax=0
16.
17.'得到最大值得索引
18.ForiInner=iLBoundToiOuter
19.IflngArray(iInner)>lngArray(iMax)TheniMax=iInner
20.NextiInner
21.
22.'值交换
23.iTemp=lngArray(iMax)
24.lngArray(iMax)=lngArray(iOuter)
25.lngArray(iOuter)=iTemp
26.
NextiOuter
27.
EndSub28.
复制代码Insertionsort
第三种(插入排序)PublicSubInsertionSort(ByReflngArray()AsLong)1.2.DimiOuterAsLong
3.DimiInnerAsLong
4.DimiLBoundAsLong
5.DimiUBoundAsLong
6.DimiTempAsLong
7.
8.iLBound=LBound(lngArray)
9.iUBound=UBound(lngArray)
10.
11.ForiOuter=iLBound+1ToiUBound
12.
13.'取得插入值
14.iTemp=lngArray(iOuter)
15.
16.'移动已经排序的值
17.ForiInner=iOuter-1ToiLBoundStep-1
18.IflngArray(iInner)<=iTempThenExitFor
19.lngArray(iInner+1)=lngArray(iInner)
20.NextiInner
21.
22.'插入值
23.lngArray(iInner+1)=iTemp
24.NextiOuter
25.EndSub
复制代码
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,ByVal
iRightEndAsLong)
27.DimiLeftCurAsLong
28.DimiRightCurAsLong
DimiPivotAsLong
29.
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 InnerQuickSortlngArray,iRightCur+1,iRightEnd 60. EndSub61.复制代码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,ByVal iLBoundAsLong,iUBoundAsLong,ByValiSegSizeAsLong) DimiSegNextAsLong 27. 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,ByVal iStartFirstAsLong,ByValiEndFirstAsLong,ByValiEndSecondAsLong) 49.DimiFirstAsLong 50.DimiSecondAsLong 51.DimiResultAsLong 52.DimiOuterAsLong 53. 54.iFirst=iStartFirst 55.iSecond=iEndFirst+1 56.iResult=iStartFirst 57. DoWhile(iFirst<=iEndFirst)And(iSecond<=iEndSecond)58. 59.IflngSrc(iFirst)<=lngSrc(iSecond)Then60.lngDest(iResult)=lngSrc(iFirst)61.iFirst=iFirst+162.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 DimiUBoundAsLong 3. 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 IfiElement>=lngArray(iChild+iLBound)ThenExitDo 35. 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. 'Foundaposition 67. IfiElement>=lngArray(iChild+iLBound)ThenExitDo68. 69.lngArray(iCurrent+iLBound)=lngArray(iChild+iLBound)70.iCurrent=iChild71.iChild=iChild+iChild72.73.Loop74.75.'Movethenode 76.lngArray(iCurrent+iLBound)=iElement77.NextiRoot78. 79. 'Copyfromtemparraytorealarray80. ForiRoot=iLBoundToiUBound81. 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) iUBound=UBound(lngArray) 12. 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 NextiOuter 44. 45. LoopUntiliFinished46.EndSub47.复制代码ShellSort (希尔排序)第八种 1.PublicSubShellSort(ByReflngArray()AsLong) 2.DimiSpacingAsLong 3.DimiOuterAsLong 4.DimiInnerAsLong 5.DimiTempAsLong 6.Dim
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- VBA 排序 算法
![提示](https://static.bingdoc.com/images/bang_tan.gif)