VBA排序的十种算法.docx
- 文档编号:4552605
- 上传时间:2022-12-06
- 格式:DOCX
- 页数:21
- 大小:19.25KB
VBA排序的十种算法.docx
《VBA排序的十种算法.docx》由会员分享,可在线阅读,更多相关《VBA排序的十种算法.docx(21页珍藏版)》请在冰豆网上搜索。
VBA排序的十种算法
在使用VBA进行写程序时,经常会做排序,下面将会给出一些常用的排序算法的实现,方便大家写程序参考,若代码中出现了错误,欢迎高手指正。
主要算法有:
1、(冒泡排序)Bubblesort
2、(选择排序)Selectionsort
3、(插入排序)Insertionsort
4、(快速排序)Quicksort
5、(合并排序)Mergesort
6、(堆排序)Heapsort
7、(组合排序)CombSort
8、(希尔排序)ShellSort
9、(基数排序)RadixSort
10、ShakerSort
第一种(冒泡排序)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
2、(选择排序)Selectionsort
1.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.
27.NextiOuter
28.EndSub
复制代码
第三种(插入排序)Insertionsort
1.PublicSubInsertionSort(ByReflngArray()AsLong)
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,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-iSp
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- VBA 排序 算法