VBA排序的十种算法.docx
《VBA排序的十种算法.docx》由会员分享，可在线阅读，更多相关《VBA排序的十种算法.docx（20页珍藏版）》请在冰豆网上搜索。
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.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,ByValiEndFirstA
升级会员 