最新vba排序的10种方法冒泡选择等.docx
- 文档编号:7934920
- 上传时间:2023-01-27
- 格式:DOCX
- 页数:18
- 大小:18.28KB
最新vba排序的10种方法冒泡选择等.docx
《最新vba排序的10种方法冒泡选择等.docx》由会员分享,可在线阅读,更多相关《最新vba排序的10种方法冒泡选择等.docx(18页珍藏版)》请在冰豆网上搜索。
最新vba排序的10种方法冒泡选择等
VBA排序的10种方法(冒泡,选择等)
[日期:
2011-08-07]
使用VBA进行写程序时,经常会做排序,下面将会给出一些常用的排序算法的实现,方便大家写程序参考,若代码中出现了错误,欢迎高手指正。
主要算法有:
1、(冒泡排序)Bubblesort
2、(选择排序)Selectionsort
3、(插入排序)Insertionsort
4、(快速排序)Quicksort
5、(合并排序)Mergesort
6、(堆排序)Heapsort
7、(组合排序)CombSort
8、(希尔排序)ShellSort
9、(基数排序)RadixSort
10、ShakerSort
后面会陆续给出这十种算法的实现
1冒泡排序
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选择排序
PublicSubSelectionSort(ByReflngArray()AsLong)
DimiOuterAsLong
DimiInnerAsLong
DimiLBoundAsLong
DimiUBoundAsLong
DimiTempAsLong
DimiMaxAsLong
iLBound=LBound(lngArray)
iUBound=UBound(lngArray)
'选择排序
ForiOuter=iUBoundToiLBound+1Step-1
iMax=0
'得到最大值得索引
ForiInner=iLBoundToiOuter
IflngArray(iInner)>lngArray(iMax)TheniMax=iInner
NextiInner
'值交换
iTemp=lngArray(iMax)
lngArray(iMax)=lngArray(iOuter)
lngArray(iOuter)=iTemp
NextiOuter
EndSub
3插入排序
PublicSubInsertionSort(ByReflngArray()AsLong)
DimiOuterAsLong
DimiInnerAsLong
DimiLBoundAsLong
DimiUBoundAsLong
DimiTempAsLong
iLBound=LBound(lngArray)
iUBound=UBound(lngArray)
ForiOuter=iLBound+1ToiUBound
'取得插入值
iTemp=lngArray(iOuter)
'移动已经排序的值
ForiInner=iOuter-1ToiLBoundStep-1
IflngArray(iInner)<=iTempThenExitFor
lngArray(iInner+1)=lngArray(iInner)
NextiInner
'插入值
lngArray(iInner+1)=iTemp
NextiOuter
EndSub
4快速排序
PublicSubQuickSort(ByReflngArray()AsLong)
DimiLBoundAsLong
DimiUBoundAsLong
DimiTempAsLong
DimiOuterAsLong
DimiMaxAsLong
iLBound=LBound(lngArray)
iUBound=UBound(lngArray)
'若只有一个值,不排序
If(iUBound-iLBound)Then
ForiOuter=iLBoundToiUBound
IflngArray(iOuter)>lngArray(iMax)TheniMax=iOuter
NextiOuter
iTemp=lngArray(iMax)
lngArray(iMax)=lngArray(iUBound)
lngArray(iUBound)=iTemp
'开始快速排序
InnerQuickSortlngArray,iLBound,iUBound
EndIf
EndSub
PrivateSubInnerQuickSort(ByReflngArray()AsLong,ByValiLeftEndAsLong,ByValiRightEndAsLong)
DimiLeftCurAsLong
DimiRightCurAsLong
DimiPivotAsLong
DimiTempAsLong
IfiLeftEnd>=iRightEndThenExitSub
iLeftCur=iLeftEnd
iRightCur=iRightEnd+1
iPivot=lngArray(iLeftEnd)
Do
Do
iLeftCur=iLeftCur+1
LoopWhilelngArray(iLeftCur) Do iRightCur=iRightCur-1 LoopWhilelngArray(iRightCur)>iPivot IfiLeftCur>=iRightCurThenExitDo '交换值 iTemp=lngArray(iLeftCur) lngArray(iLeftCur)=lngArray(iRightCur) lngArray(iRightCur)=iTemp Loop '递归快速排序 lngArray(iLeftEnd)=lngArray(iRightCur) lngArray(iRightCur)=iPivot InnerQuickSortlngArray,iLeftEnd,iRightCur-1 InnerQuickSortlngArray,iRightCur+1,iRightEnd EndSub 5合并排序 PublicSubMergeSort(ByReflngArray()AsLong) DimarrTemp()AsLong DimiSegSizeAsLong DimiLBoundAsLong DimiUBoundAsLong iLBound=LBound(lngArray) iUBound=UBound(lngArray) ReDimarrTemp(iLBoundToiUBound) iSegSize=1 DoWhileiSegSize '合并A到B InnerMergePasslngArray,arrTemp,iLBound,iUBound,iSegSize iSegSize=iSegSize+iSegSize '合并B到A InnerMergePassarrTemp,lngArray,iLBound,iUBound,iSegSize iSegSize=iSegSize+iSegSize Loop EndSub PrivateSubInnerMergePass(ByReflngSrc()AsLong,ByReflngDest()AsLong,ByValiLBoundAsLong,iUBoundAsLong,ByValiSegSizeAsLong) DimiSegNextAsLong iSegNext=iLBound DoWhileiSegNext<=iUBound-(2*iSegSize) '合并 InnerMergelngSrc,lngDest,iSegNext,iSegNext+iSegSize-1,iSegNext+iSegSize+iSegSize-1 iSegNext=iSegNext+iSegSize+iSegSize Loop IfiSegNext+iSegSize<=iUBoundThen InnerMergelngSrc,lngDest,iSegNext,iSegNext+iSegSize-1,iUBound Else ForiSegNext=iSegNextToiUBound lngDest(iSegNext)=lngSrc(iSegNext) NextiSegNext EndIf EndSub PrivateSubInnerMerge(ByReflngSrc()AsLong,ByReflngDest()AsLong,ByValiStartFirstAsLong,ByValiEndFirstAsLong,ByValiEndSecondAsLong) DimiFirstAsLong DimiSecondAsLong DimiResultAsLong DimiOuterAsLong iFirst=iStartFirst iSecond=iEndFirst+1 iResult=iStartFirst DoWhile(iFirst<=iEndFirst)And(iSecond<=iEndSecond) IflngSrc(iFirst)<=lngSrc(iSecond)Then lngDest(iResult)=lngSrc(iFirst) iFirst=iFirst+1 Else lngDest(iResult)=lngSrc(iSecond) iSecond=iSecond+1 EndIf iResult=iResult+1 Loop IfiFirst>iEndFirstThen ForiOuter=iSecondToiEndSecond lngDest(iResult)=lngSrc(iOuter) iResult=iResult+1 NextiOuter Else ForiOuter=iFirstToiEndFirst lngDest(iResult)=lngSrc(iOuter) iResult=iResult+1 NextiOuter EndIf EndSub 6堆排序 PublicSubHeapSort(ByReflngArray()AsLong) DimiLBoundAsLong DimiUBoundAsLong DimiArrSizeAsLong DimiRootAsLong DimiChildAsLong DimiElementAsLong DimiCurrentAsLong DimarrOut()AsLong iLBound=LBound(lngArray) iUBound=UBound(lngArray) iArrSize=iUBound-iLBound ReDimarrOut(iLBoundToiUBound) 'Initialisetheheap 'Moveuptheheapfromthebottom ForiRoot=iArrSize\2To0Step-1 iElement=lngArray(iRoot+iLBound) iChild=iRoot+iRoot 'Movedowntheheapfromthecurrentposition DoWhileiChild IfiChild IflngArray(iChild+iLBound) 'Alwayswantlargestchild iChild=iChild+1 EndIf EndIf 'Foundaslot,stoplooking IfiElement>=lngArray(iChild+iLBound)ThenExitDo lngArray((iChild\2)+iLBound)=lngArray(iChild+iLBound) iChild=iChild+iChild Loop 'Movethenode lngArray((iChild\2)+iLBound)=iElement NextiRoot 'Readofvaluesonebyone(storeinarraystartingattheend) ForiRoot=iUBoundToiLBoundStep-1 'Readthevalue arrOut(iRoot)=lngArray(iLBound) 'Getthelastelement iElement=lngArray(iArrSize+iLBound) iArrSize=iArrSize-1 iCurrent=0 iChild=1 'Findaplaceforthelastelementtogo DoWhileiChild<=iArrSize IfiChild IflngArray(iChild+iLBound) 'Alwayswantthelargerchild iChild=iChild+1 EndIf EndIf 'Foundaposition IfiElement>=lngArray(iChild+iLBound)ThenExitDo lngArray(iCurrent+iLBound)=lngArray(iChild+iLBound) iCurrent=iChild iChild=iChild+iChild Loop 'Movethenode lngArray(iCurrent+iLBound)=iElement NextiRoot 'Copyfromtemparraytorealarray ForiRoot=iLBoundToiUBound lngArray(iRoot)=arrOut(iRoot) NextiRoot EndSub 7组合排序 PublicSubCombSort(ByReflngArray()AsLong) DimiSpacingAsLong DimiOuterAsLong DimiInnerAsLong DimiTempAsLong DimiLBoundAsLong DimiUBoundAsLong DimiArrSizeAsLong DimiFinishedAsLong iLBound=LBound(lngArray) iUBound=UBound(lngArray) 'Initialisecombwidth iSpacing=iUBound-iLBound Do IfiSpacing>1Then iSpacing=Int(iSpacing/1.3) IfiSpacing=0Then iSpacing=1'Dontgolowerthan1 ElseIfiSpacing>8AndiSpacing<11Then iSpacing=11'Thisisaspecialnumber,goesfasterthan9and10 EndIf EndIf 'Alwaysgodownto1beforeattemptingtoexit IfiSpacing=1TheniFinished=1 'Combingpass ForiOuter=iLBoundToiUBound-iSpacing iInner=iOuter+iSpacing IflngArray(iOuter)>lngArray(iInner)Then 'Swap iTemp=lngArray(iOuter) lngArray(iOuter)=lngArray(iInner) lngArray(iInner)=iTemp 'Notfinished iFinished=0 EndIf NextiOuter LoopUntiliFinished EndSub 8希尔排序 PublicSubShellSort(ByReflngArray()AsLong) DimiSpacingAsLong DimiOuterAsLong DimiInnerAsLong DimiTempAsLong DimiLBoundAsLong DimiUBoundAsLong DimiArrSizeAsLong iLBound=LBound(lngArray) iUBound=UBound(lngArray) 'Calculateinitialsortspacing iArrSize=(iUBound-iLBound)+1 iSpacing=1 IfiArrSize>13Then DoWhileiSpacing iSpacing=(3*iSpacing)+1 Loop iSpacing=iSpacing\9 EndIf 'Startsorting DoWhileiSpacing ForiOuter=iLBound+iSpacingToiUBound 'Getthevaluetobeinserted iTemp=lngArray(iOuter) 'Movealongthealreadysortedvaluesshiftingalong ForiInner=iOuter-iSpacingToiLBoundStep-iSpacing 'Nomoreshiftingneeded,wefoundtherightspot! IflngArray(iInner)<=iTempThenExitFor lngArray(iInner+iSpacing)=lngArray(iInner) NextiInner 'Insertvalueintheslot lngArray(iInner+iSpacing)=iTemp NextiOuter 'Reducethesortspacing iSpacing=iSpacing\3 Loop EndSub 9基数排序 PublicSubRadixSort(ByReflngArray()AsLong) DimarrTemp()AsLong DimiLBoundAsLong DimiUBoundAsLong DimiMaxAsLong DimiSortsAsLong DimiLoopAsLong iLBound=LBound(lngArray) iUBound=UBound(lngArray) 'Createswaparray ReDimarrTemp(iLBoundToiUBound) iMax=&H80000000 'Findlargest ForiLoop=iLBoundToiUBound IflngArray(iLoop)>iMaxTheniMax=lngArray(iLoop) NextiLoop 'Calculatehowmanysortsareneeded DoWhileiMax iSorts=iSorts+1 iMax=iM
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- 最新 vba 排序 10 方法 冒泡 选择