VBA排序的十种算法.docx
《VBA排序的十种算法.docx》由会员分享，可在线阅读，更多相关《VBA排序的十种算法.docx（17页珍藏版）》请在冰豆网上搜索。
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.iLBound=LBound（lngArray）
9.iUBound=UBound（lngArray）
10.'选择排序
11.ForiOuter=iUBoundToiLBound+1Step-1
12.iMax=0
13.'得到最大值得索引
14.ForiInner=iLBoundToiOuter
15.IflngArray（iInner）>lngArray（iMax）TheniMax=iInner
16.NextiInner
17.'值交换
18.iTemp=lngArray（iMax）
19.lngArray（iMax）=lngArray（iOuter）
20.lngArray（iOuter）=iTemp
21.NextiOuter
22.EndSub
复制代码
第三种（插入排序）Insertionsort
1.PublicSubInsertionSort（ByReflngArray（）AsLong）
2.DimiOuterAsLong
3.DimiInnerAsLong
4.DimiLBoundAsLong
5.DimiUBoundAsLong
6.DimiTempAsLong
7.iLBound=LBound（lngArray）
8.iUBound=UBound（lngArray）
9.ForiOuter=iLBound+1ToiUBound
10.'取得插入值
11.iTemp=lngArray（iOuter）
12.'移动已经排序的值
13.ForiInner=iOuter-1ToiLBoundStep-1
14.IflngArray（iInner）<=iTempThenExitFor
15.lngArray（iInner+1）=lngArray（iInner）
16.NextiInner
17.'插入值
18.lngArray（iInner+1）=iTemp
19.NextiOuter
20.EndSub
复制代码
第四种（快速排序）Quicksort
1.PublicSubQuickSort（ByReflngArray（）AsLong）
2.DimiLBoundAsLong
3.DimiUBoundAsLong
4.DimiTempAsLong
5.DimiOuterAsLong
6.DimiMaxAsLong
7.iLBound=LBound（lngArray）
8.iUBound=UBound（lngArray）
9.'若只有一个值，不排序
10.If（iUBound-iLBound）Then
11.ForiOuter=iLBoundToiUBound
12.IflngArray（iOuter）>lngArray（iMax）TheniMax=iOuter
13.NextiOuter
14.iTemp=lngArray（iMax）
15.lngArray（iMax）=lngArray（iUBound）
16.lngArray（iUBound）=iTemp
17.'开始快速排序
18.InnerQuickSortlngArray,iLBound,iUBound
19.EndIf
20.EndSub
21.PrivateSubInnerQuickSort（ByReflngArray（）AsLong,ByValiLeftEndAsLong,ByValiRightEndAsLong）
22.DimiLeftCurAsLong
23.DimiRightCurAsLong
24.DimiPivotAsLong
25.DimiTempAsLong
26.IfiLeftEnd>=iRightEndThenExitSub
27.iLeftCur=iLeftEnd
28.iRightCur=iRightEnd+1
29.iPivot=lngArray（iLeftEnd）
30.Do
31.Do
32.iLeftCur=iLeftCur+1
33.LoopWhilelngArray（iLeftCur）34.Do
35.iRightCur=iRightCur-1
36.LoopWhilelngArray（iRightCur）>iPivot
37.IfiLeftCur>=iRightCurThenExitDo
38.'交换值
39.iTemp=lngArray（iLeftCur）
40.lngArray（iLeftCur）=lngArray（iRightCur）
41.lngArray（iRightCur）=iTemp
42.Loop
43.'递归快速排序
44.lngArray（iLeftEnd）=lngArray（iRightCur）
45.lngArray（iRightCur）=iPivot
46.InnerQuickSortlngArray,iLeftEnd,iRightCur-1
47.InnerQuickSortlngArray,iRightCur+1,iRightEnd
48.EndSub
复制代码
第五种（合并排序）Mergesort
1.PublicSubMergeSort（ByReflngArray（）AsLong）
2.DimarrTemp（）AsLong
3.DimiSegSizeAsLong
4.DimiLBoundAsLong
5.DimiUBoundAsLong
6.iLBound=LBound（lngArray）
7.iUBound=UBound（lngArray）
8.ReDimarrTemp（iLBoundToiUBound）
9.iSegSize=1
10.DoWhileiSegSize11.'合并A到B
12.InnerMergePasslngArray,arrTemp,iLBound,iUBound,iSegSize
13.iSegSize=iSegSize+iSegSize
14.'合并B到A
15.InnerMergePassarrTemp,lngArray,iLBound,iUBound,iSegSize
16.iSegSize=iSegSize+iSegSize
17.Loop
18.EndSub
19.PrivateSubInnerMergePass（ByReflngSrc（）AsLong,ByReflngDest（）AsLong,ByValiLBoundAsLong,iUBoundAsLong,ByValiSegSizeAsLong）
20.DimiSegNextAsLong
21.iSegNext=iLBound
22.DoWhileiSegNext<=iUBound-（2*iSegSize）
23.'合并
24.InnerMergelngSrc,lngDest,iSegNext,iSegNext+iSegSize-1,iSegNext+iSegSize+iSegSize-1
25.iSegNext=iSegNext+iSegSize+iSegSize
26.Loop
27.IfiSegNext+iSegSize<=iUBoundThen
28.InnerMergelngSrc,lngDest,iSegNext,iSegNext+iSegSize-1,iUBound
29.Else
30.ForiSegNext=iSegNextToiUBound
31.lngDest（iSegNext）=lngSrc（iSegNext）
32.NextiSegNext
33.EndIf
34.EndSub
35.PrivateSubInnerMerge（ByReflngSrc（）AsLong,ByReflngDest（）AsLong,ByValiStartFirstAsLong,ByValiEndFirstAsLong,ByValiEndSecondAsLong）
36.DimiFirstAsLong
37.DimiSecondAsLong
38.DimiResultAsLong
39.DimiOuterAsLong
40.iFirst=iStartFirst
41.iSecond=iEndFirst+1
42.iResult=iStartFirst
43.DoWhile（iFirst<=iEndFirst）And（iSecond<=iEndSecond）
44.IflngSrc（iFirst）<=lngSrc（iSecond）Then
45.lngDest（iResult）=lngSrc（iFirst）
46.iFirst=iFirst+1
47.Else
48.lngDest（iResult）=lngSrc（iSecond）
49.iSecond=iSecond+1
50.EndIf
51.iResult=iResult+1
52.Loop
53.IfiFirst>iEndFirstThen
54.ForiOuter=iSecondToiEndSecond
55.lngDest（iResult）=lngSrc（iOuter）
56.iResult=iResult+1
57.NextiOuter
58.Else
59.ForiOuter=iFirstToiEndFirst
60.lngDest（iResult）=lngSrc（iOuter）
61.iResult=iResult+1
62.NextiOuter
63.EndIf
64.EndSub
复制代码
第六种（堆排序）Heapsort
1.PublicSubHeapSort（ByReflngArray（）AsLong）
2.DimiLBoundAsLong
3.DimiUBoundAsLong
4.DimiArrSizeAsLong
5.DimiRootAsLong
6.DimiChildAsLong
7.DimiElementAsLong
8.DimiCurrentAsLong
9.DimarrOut（）AsLong
10.iLBound=LBound（lngArray）
11.iUBound=UBound（lngArray）
12.iArrSize=iUBound-iLBound
13.ReDimarrOut（iLBoundToiUBound）
14.'Initialisetheheap
15.'Moveuptheheapfromthebottom
16.ForiRoot=iArrSize\2To0Step-1
17.iElement=lngArray（iRoot+iLBound）
18.iChild=iRoot+iRoot
19.'Movedowntheheapfromthecurrentposition
20.DoWhileiChild21.IfiChild22.IflngArray（iChild+iLBound）23.'Alwayswantlargestchild
24.iChild=iChild+1
25.EndIf
26.EndIf
27.'Foundaslot,stoplooking
28.IfiElement>=lngArray（iChild+iLBound）ThenExitDo
29.lngArray（（iChild\2）+iLBound）=lngArray（iChild+iLBound）
30.iChild=iChild+iChild
31.Loop
32.'Movethenode
33.lngArray（（iChild\2）+iLBound）=iElement
34.NextiRoot
35.'Readofvaluesonebyone（storeinarraystartingattheend）
36.ForiRoot=iUBoundToiLBoundStep-1
37.'Readthevalue
38.arrOut（iRoot）=lngArray（iLBound）
39.'Getthelastelement
40.iElement=lngArray（iArrSize+iLBound）
41.iArrSize=iArrSize-1
42.iCurrent=0
43.iChild=1
44.'Findaplaceforthelastelementtogo
45.DoWhileiChild<=iArrSize
46.IfiChild47.IflngArray（iChild+iLBound）48.'Alwayswantthelargerchild
49.iChild=iChild+1
50.EndIf
51.EndIf
52.'Foundaposition
53.IfiElement>=lngArray（iChild+iLBound）ThenExitDo
54.lngArray（iCurrent+iLBound）=lngArray（iChild+iLBound）
55.iCurrent=iChild
56.iChild=iChild+iChild
57.Loop
58.'Movethenode
59.lngArray（iCurrent+iLBound）=iElement
60.NextiRoot
61.'Copyfromtemparraytorealarray
62.ForiRoot=iLBoundToiUBound
63.lngArray（iRoot）=arrOut（iRoot）
64.NextiRoot
65.EndSub
复制代码
第七种（组合排序）CombSort
1.PublicSubCombSort（ByReflngArray（）AsLong）
2.DimiSpacingAsLong
3.DimiOuterAsLong
4.DimiInnerAsLong
5.DimiTempAsLong
6.DimiLBoundAsLong
7.DimiUBoundAsLong
8.DimiArrSizeAsLong
9.DimiFinishedAsLong
10.iLBound=LBound（lngArray）
11.iUBound=UBound（lngArray）
12.'Initialisecombwidth
13.iSpacing=iUBound-iLBound
14.Do
15.IfiSpacing>1Then
16.iSpacing=Int（iSpacing/1.3）
17.IfiSpacing=0Then
18.iSpacing=1'Dontgolowerthan1
19.ElseIfiSpacing>8AndiSpacing<11Then
20.iSpacing=11'Thisisaspecialnumber,goesfasterthan9and10
21.EndIf
22.EndIf
23.'Alwaysgodownto1beforeattemptingtoexit
24.IfiSpacing=1TheniFinished=1
25.'Combingpass
26.ForiOuter=iLBoundToiUBound-iSpacing
27.iInner=iOuter+iSpacing
28.IflngArray（iOuter）>lngArray（iInner）Then
29.'Swap
30.iTemp=lngArray（iOuter）
31.lngArray（iOuter）=lngArray（iInner）
32.lngArray（iInner）=iTemp
33.'Notfinished
34.iFinished=0
35.EndIf
36.NextiOuter
37.LoopUntiliFinished
38.EndSub
复制代码
第八种（希尔排序）ShellSort
1.PublicSubShellSort（ByReflngArray（）AsLong）
2.DimiSpacingAsLong
3.DimiOuterAsLong
4.DimiInnerAsLong
5.DimiTempAsLong
6.DimiLBoundAsLong
7.DimiUBoundAsLong
8.DimiArrSizeAsLong
9.iLBound=LBound（lngArray）
10.iUBound=UBound（lngArray）
11.'Calculateinitialsortspacing
12.iArrSize=（iUBound-iLBound）+1
13.iSpacing=1
14.IfiArrSize>13Then
15.DoWhileiSpacing16.iSpacing=（3*iSpacing）+1
17.Loop
18.iSpacing=iSpacing\9
19.EndIf
20.'Startsorting
21.DoWhileiSpacing
22.ForiOuter=iLBound+iSpacingToiUBound
23.'Getthevaluetobeinserted
24.iTemp=lngArray（iOuter）
25.'Movealongthealreadysortedvaluesshiftingalong
26.ForiInner=iOuter-iSpacingToiLBoundStep-iSpacing
27.'Nomoreshiftingneeded,wefoundtherightspot!
28.IflngArray（iInner）<=iTempThenExitFor
29.lngArray（iInner+iSpacing）=lngArray（iInner）
30.NextiInner
31.'Insertvalueintheslot
32.lngArray（iInner+iSpacing）=iTemp
33.NextiOuter
34.'Reducethesortspacing
35.iSpacing=iSpacing\3
36.Loop
37.EndSub
复制代码
第九种（基数排序）RadixSort
1.PublicSubRadixSort（ByReflngArray（）AsLong）
2.DimarrTemp（）AsLong
3.DimiLBoundAsLong
4.DimiUBoundAsLong
5.DimiMaxAsLong
6.DimiSortsAsLong
7.DimiLoopAsLong
8.iLBound=LBound（lngArray）
9.iUBound=UBound（lngArray）
10.'Createswaparray
11.ReDimarrTemp（iLBoundToiUBound）
12.iMax=
13.'Findlargest
14.ForiLoop=iLBoundToiUBound
15.IflngArray（iLoop）>iMaxTheniMax=lngArray（iLoop）
16.NextiLoop
17.'Calculatehowmanysortsareneeded
18.DoWhileiMax
19.iSorts=iSorts+1
20.iMax=iMax\256
21.Loop
22.iMax=1
23.'Dothesorts
24.ForiLoop=1ToiSorts
25.IfiLoopAnd1Then
26.'Oddsort->srctodest
27.InnerRadixSortlngArray,arrTemp,iLBound,iUBound,iMax
28.Else
29.'Evensort->desttosrc
30.InnerRadixSortarrTemp,lngArray,iLBound,iUBound,iMax
31.EndIf
32.'Nextsortfactor
33.iMax=iMax*256
34.NextiLoop
35.'Ifoddnumbero
升级会员 