VBA排序的十種算法

-.z.在使用VBA進(jìn)行寫(xiě)程序時(shí)，經(jīng)常會(huì)做排序，下面將會(huì)給出一些常用的排序算法的實(shí)現(xiàn)，方便大家寫(xiě)程序參考，若代碼中出現(xiàn)了錯(cuò)誤，歡迎高手指正。主要算法有：1、（冒泡排序）Bubblesort

2、（選擇排序）Selectionsort

3、（插入排序）Insertionsort

4、（快速排序）Quicksort

5、（合并排序）Mergesort

6、（堆排序）Heapsort

7、（組合排序）bSort

8、（希爾排序）ShellSort

9、（基數(shù)排序）Radi*Sort

10、ShakerSort第一種（冒泡排序）BubblesortPublicSubBubbleSort(ByReflngArray()AsLong)DimiOuterAsLongDimiInnerAsLongDimiLBoundAsLongDimiUBoundAsLongDimiTempAsLongiLBound=LBound(lngArray)iUBound=UBound(lngArray)'冒泡排序ForiOuter=iLBoundToiUBound-1ForiInner=iLBoundToiUBound-iOuter-1'比較相鄰項(xiàng)IflngArray(iInner)>lngArray(iInner+1)Then'交換值iTemp=lngArray(iInner)lngArray(iInner)=lngArray(iInner+1)lngArray(iInner+1)=iTempEndIfNe*tiInnerNe*tiOuterEndSub2、（選擇排序）SelectionsortPublicSubSelectionSort(ByReflngArray()AsLong)DimiOuterAsLongDimiInnerAsLongDimiLBoundAsLongDimiUBoundAsLongDimiTempAsLongDimiMa*AsLongiLBound=LBound(lngArray)iUBound=UBound(lngArray)'選擇排序ForiOuter=iUBoundToiLBound+1Step-1iMa*=0'得到最大值得索引ForiInner=iLBoundToiOuterIflngArray(iInner)>lngArray(iMa*)TheniMa*=iInnerNe*tiInner'值交換iTemp=lngArray(iMa*)lngArray(iMa*)=lngArray(iOuter)lngArray(iOuter)=iTempNe*tiOuterEndSub復(fù)制代碼第三種（插入排序）InsertionsortPublicSubInsertionSort(ByReflngArray()AsLong)DimiOuterAsLongDimiInnerAsLongDimiLBoundAsLongDimiUBoundAsLongDimiTempAsLongiLBound=LBound(lngArray)iUBound=UBound(lngArray)ForiOuter=iLBound+1ToiUBound'取得插入值iTemp=lngArray(iOuter)'移動(dòng)已經(jīng)排序的值ForiInner=iOuter-1ToiLBoundStep-1IflngArray(iInner)<=iTempThenE*itForlngArray(iInner+1)=lngArray(iInner)Ne*tiInner'插入值lngArray(iInner+1)=iTempNe*tiOuterEndSub復(fù)制代碼第四種（快速排序）QuicksortPublicSubQuickSort(ByReflngArray()AsLong)DimiLBoundAsLongDimiUBoundAsLongDimiTempAsLongDimiOuterAsLongDimiMa*AsLongiLBound=LBound(lngArray)iUBound=UBound(lngArray)'若只有一個(gè)值，不排序If(iUBound-iLBound)ThenForiOuter=iLBoundToiUBoundIflngArray(iOuter)>lngArray(iMa*)TheniMa*=iOuterNe*tiOuteriTemp=lngArray(iMa*)lngArray(iMa*)=lngArray(iUBound)lngArray(iUBound)=iTemp'開(kāi)始快速排序InnerQuickSortlngArray,iLBound,iUBoundEndIfEndSubPrivateSubInnerQuickSort(ByReflngArray()AsLong,ByValiLeftEndAsLong,ByValiRightEndAsLong)DimiLeftCurAsLongDimiRightCurAsLongDimiPivotAsLongDimiTempAsLongIfiLeftEnd>=iRightEndThenE*itSubiLeftCur=iLeftEndiRightCur=iRightEnd+1iPivot=lngArray(iLeftEnd)DoDoiLeftCur=iLeftCur+1LoopWhilelngArray(iLeftCur)<iPivotDoiRightCur=iRightCur-1LoopWhilelngArray(iRightCur)>iPivotIfiLeftCur>=iRightCurThenE*itDo'交換值iTemp=lngArray(iLeftCur)lngArray(iLeftCur)=lngArray(iRightCur)lngArray(iRightCur)=iTempLoop'遞歸快速排序lngArray(iLeftEnd)=lngArray(iRightCur)lngArray(iRightCur)=iPivotInnerQuickSortlngArray,iLeftEnd,iRightCur-1InnerQuickSortlngArray,iRightCur+1,iRightEndEndSub復(fù)制代碼第五種（合并排序）MergesortPublicSubMergeSort(ByReflngArray()AsLong)DimarrTemp()AsLongDimiSegSizeAsLongDimiLBoundAsLongDimiUBoundAsLongiLBound=LBound(lngArray)iUBound=UBound(lngArray)ReDimarrTemp(iLBoundToiUBound)iSegSize=1DoWhileiSegSize<iUBound-iLBound'合并A到BInnerMergePasslngArray,arrTemp,iLBound,iUBound,iSegSizeiSegSize=iSegSize+iSegSize'合并B到AInnerMergePassarrTemp,lngArray,iLBound,iUBound,iSegSizeiSegSize=iSegSize+iSegSizeLoopEndSubPrivateSubInnerMergePass(ByReflngSrc()AsLong,ByReflngDest()AsLong,ByValiLBoundAsLong,iUBoundAsLong,ByValiSegSizeAsLong)DimiSegNe*tAsLongiSegNe*t=iLBoundDoWhileiSegNe*t<=iUBound-(2*iSegSize)'合并InnerMergelngSrc,lngDest,iSegNe*t,iSegNe*t+iSegSize-1,iSegNe*t+iSegSize+iSegSize-1iSegNe*t=iSegNe*t+iSegSize+iSegSizeLoopIfiSegNe*t+iSegSize<=iUBoundThenInnerMergelngSrc,lngDest,iSegNe*t,iSegNe*t+iSegSize-1,iUBoundElseForiSegNe*t=iSegNe*tToiUBoundlngDest(iSegNe*t)=lngSrc(iSegNe*t)Ne*tiSegNe*tEndIfEndSubPrivateSubInnerMerge(ByReflngSrc()AsLong,ByReflngDest()AsLong,ByValiStartFirstAsLong,ByValiEndFirstAsLong,ByValiEndSecondAsLong)DimiFirstAsLongDimiSecondAsLongDimiResultAsLongDimiOuterAsLongiFirst=iStartFirstiSecond=iEndFirst+1iResult=iStartFirstDoWhile(iFirst<=iEndFirst)And(iSecond<=iEndSecond)IflngSrc(iFirst)<=lngSrc(iSecond)ThenlngDest(iResult)=lngSrc(iFirst)iFirst=iFirst+1ElselngDest(iResult)=lngSrc(iSecond)iSecond=iSecond+1EndIfiResult=iResult+1LoopIfiFirst>iEndFirstThenForiOuter=iSecondToiEndSecondlngDest(iResult)=lngSrc(iOuter)iResult=iResult+1Ne*tiOuterElseForiOuter=iFirstToiEndFirstlngDest(iResult)=lngSrc(iOuter)iResult=iResult+1Ne*tiOuterEndIfEndSub復(fù)制代碼第六種（堆排序）HeapsortPublicSubHeapSort(ByReflngArray()AsLong)DimiLBoundAsLongDimiUBoundAsLongDimiArrSizeAsLongDimiRootAsLongDimiChildAsLongDimiElementAsLongDimiCurrentAsLongDimarrOut()AsLongiLBound=LBound(lngArray)iUBound=UBound(lngArray)iArrSize=iUBound-iLBoundReDimarrOut(iLBoundToiUBound)'Initialisetheheap'MoveuptheheapfromthebottomForiRoot=iArrSize\2To0Step-1iElement=lngArray(iRoot+iLBound)iChild=iRoot+iRoot'MovedowntheheapfromthecurrentpositionDoWhileiChild<iArrSizeIfiChild<iArrSizeThenIflngArray(iChild+iLBound)<lngArray(iChild+iLBound+1)Then'AlwayswantlargestchildiChild=iChild+1EndIfEndIf'Foundaslot,stoplookingIfiElement>=lngArray(iChild+iLBound)ThenE*itDolngArray((iChild\2)+iLBound)=lngArray(iChild+iLBound)iChild=iChild+iChildLoop'MovethenodelngArray((iChild\2)+iLBound)=iElementNe*tiRoot'Readofvaluesonebyone(storeinarraystartingattheend)ForiRoot=iUBoundToiLBoundStep-1'ReadthevaluearrOut(iRoot)=lngArray(iLBound)'GetthelastelementiElement=lngArray(iArrSize+iLBound)iArrSize=iArrSize-1iCurrent=0iChild=1'FindaplaceforthelastelementtogoDoWhileiChild<=iArrSizeIfiChild<iArrSizeThenIflngArray(iChild+iLBound)<lngArray(iChild+iLBound+1)Then'AlwayswantthelargerchildiChild=iChild+1EndIfEndIf'FoundapositionIfiElement>=lngArray(iChild+iLBound)ThenE*itDolngArray(iCurrent+iLBound)=lngArray(iChild+iLBound)iCurrent=iChildiChild=iChild+iChildLoop'MovethenodelngArray(iCurrent+iLBound)=iElementNe*tiRoot'CopyfromtemparraytorealarrayForiRoot=iLBoundToiUBoundlngArray(iRoot)=arrOut(iRoot)Ne*tiRootEndSub復(fù)制代碼第七種（組合排序）bSortPublicSubbSort(ByReflngArray()AsLong)DimiSpacingAsLongDimiOuterAsLongDimiInnerAsLongDimiTempAsLongDimiLBoundAsLongDimiUBoundAsLongDimiArrSizeAsLongDimiFinishedAsLongiLBound=LBound(lngArray)iUBound=UBound(lngArray)'InitialisebwidthiSpacing=iUBound-iLBoundDoIfiSpacing>1TheniSpacing=Int(iSpacing/1.3)IfiSpacing=0TheniSpacing=1'Dontgolowerthan1ElseIfiSpacing>8AndiSpacing<11TheniSpacing=11'Thisisaspecialnumber,goesfasterthan9and10EndIfEndIf'Alwaysgodownto1beforeattemptingtoe*itIfiSpacing=1TheniFinished=1'bingpassForiOuter=iLBoundToiUBound-iSpacingiInner=iOuter+iSpacingIflngArray(iOuter)>lngArray(iInner)Then'SwapiTemp=lngArray(iOuter)lngArray(iOuter)=lngArray(iInner)lngArray(iInner)=iTemp'NotfinishediFinished=0EndIfNe*tiOuterLoopUntiliFinishedEndSub復(fù)制代碼第八種（希爾排序）ShellSortPublicSubShellSort(ByReflngArray()AsLong)DimiSpacingAsLongDimiOuterAsLongDimiInnerAsLongDimiTempAsLongDimiLBoundAsLongDimiUBoundAsLongDimiArrSizeAsLongiLBound=LBound(lngArray)iUBound=UBound(lngArray)'CalculateinitialsortspacingiArrSize=(iUBound-iLBound)+1iSpacing=1IfiArrSize>13ThenDoWhileiSpacing<iArrSizeiSpacing=(3*iSpacing)+1LoopiSpacing=iSpacing\9EndIf'StartsortingDoWhileiSpacingForiOuter=iLBound+iSpacingToiUBound'GetthevaluetobeinsertediTemp=lngArray(iOuter)'MovealongthealreadysortedvaluesshiftingalongForiInner=iOuter-iSpacingToiLBoundStep-iSpacing'Nomoreshiftingneeded,wefoundtherightspot!IflngArray(iInner)<=iTempThenE*itForlngArray(iInner+iSpacing)=lngArray(iInner)Ne*tiInner'InsertvalueintheslotlngArray(iInner+iSpacing)=iTempNe*tiOuter'ReducethesortspacingiSpacing=iSpacing\3LoopEndSub復(fù)制代碼第九種（基數(shù)排序）Radi*SortPublicSubRadi*Sort(ByReflngArray()AsLong)DimarrTemp()AsLongDimiLBoundAsLongDimiUBoundAsLongDimiMa*AsLongDimiSortsAsLongDimiLoopAsLongiLBound=LBound(lngArray)iUBound=UBound(lngArray)'CreateswaparrayReDimarrTemp(iLBoundToiUBound)iMa*=&H80000000'FindlargestForiLoop=iLBoundToiUBoundIflngArray(iLoop)>iMa*TheniMa*=lngArray(iLoop)Ne*tiLoop'CalculatehowmanysortsareneededDoWhileiMa*iSorts=iSorts+1iMa*=iMa*\256LoopiMa*=1'DothesortsForiLoop=1ToiSortsIfiLoopAnd1Then'Oddsort->srctodestInnerRadi*SortlngArray,arrTemp,iLBound,iUBound,iMa*Else'Evensort->desttosrcInnerRadi*SortarrTemp,lngArray,iLBound,iUBound,iMa*EndIf'Ne*tsortfactoriMa*=iMa**256Ne*tiLoop'IfoddnumberofsortsweneedtoswapthearraysIf(iSortsAnd1)ThenForiLoop=iLBoundToiUBoundlngArray(iLoop)=arrTemp(iLoop)Ne*tiLoopEndIfEndSubPrivateSubInnerRadi*Sort(ByReflngSrc()AsLong,ByReflngDest()AsLong,ByValiLBoundAsLong,ByValiUBoundAsLong,ByValiDivisorAsLong)DimarrCounts(255)AsLongDimarrOffsets(255)AsLongDimiBucketAsLongDimiLoopAsLong'CounttheitemsforeachbucketForiLoop=iLBoundToiUBoundiBucket=(lngSrc(iLoop)\iDivisor)And255arrCounts(iBucket)=arrCounts(iBucket)+1Ne*tiLoop'GenerateoffsetsForiLoop=1To255arrOffsets(iLoop)=arrOffsets(iLoop-1)+arrCo