VBA排序的十种算法.docx
《VBA排序的十种算法.docx》由会员分享，可在线阅读，更多相关《VBA排序的十种算法.docx（20页珍藏版）》请在冰豆网上搜索。
VBA排序的十种算法
在使用VBA进行写程序时，经常会做排序，下面将会给出一些常用的排序算法的实现，方便大家写程序参考，若代码中出现了错误，欢迎高手指正。
主要算法有：
1、（冒泡排序）Bubblesort
2、（选择排序）Selectionsort
3、（插入排序）Insertionsort
4、（快速排序）Quicksort
5、（合并排序）Mergesort
6、（堆排序）Heapsort
7、（组合排序）bSort
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.DoWhileiSegSize14.
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.DoWhileiChild26.
27.IfiChild28.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.IfiChild61.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
复制代码
第七种（组合排序）bSort
1.PublicSubbSort（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.'Initialisebwidth
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.'bingpass
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.DoWhileiSpacing19.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,wefoundtheright
升级会员 