VBA排序之(冒泡排序、选择排序、插⼊排序、快速排序、希尔
排序)
主程序:
Sub mymain()
Dim MainArr, t
Application.ScreenUpdating = False
t = timer
With ThisWorkbook.Worksheets("排序")
MainArr = .Range("a2: a" & Cells(Rows.Count, "a").End(xlUp).Row)
InsertionSort arr:=MainArr
.Range("c2").Resize(UBound(MainArr), 1) = MainArr
End With
MsgBox Format(timer - t, "0.00s")
Application.ScreenUpdating = True
End Sub'
1、冒泡排序运作⽅式:
1.1、⽐较相邻的两个元素,按所需顺序决定是否交换。
1.2、对每⼀对相邻元素进⾏同样的⼯作,从第⼀对⾄最后⼀对。结束后,最后⼀个元素应该是所需顺序的最值(如所需顺序为由⼩⾄⼤,则为最⼤值)。
1.3、对所有元素重复上述步骤,除了最后⼀个。
1.4、重复前述步骤,称前部分需要对⽐的为⽆序区,后部分不需要对⽐的为有序区,直到⽆序区仅剩⼀个元素。
Sub BubbleSort(ByRef arr)
Dim i&, j&, vSwap
For i = UBound(arr) To2Step -1
For j = 1To i - 1
If arr(j, 1) > arr(j + 1, 1) Then
vSwap = arr(j, 1)
arr(j, 1) = arr(j + 1, 1)
arr(j + 1, 1) = vSwap
End If
Next
Next
End Sub
2、选择排序运作⽅式:
2.1、对(⽆序区)全部元素由前⾄后扫描,出最值。
2.2、将最值元素与(⽆序区)第⼀个元素交换,此时前端为有序区,后端为⽆序区。
2.3、重复上述步骤,直到⽆序区仅剩⼀个元素。
Sub SelectionSort(ByRef arr)
Dim i&, j&, vSwap, min&
For i = 1To UBound(arr)
min = i
For j = i + 1To UBound(arr)
If arr(min, 1) > arr(j, 1) Then min = j
Next
If min <> i Then
vSwap = arr(min, 1)
arr(min, 1) = arr(i, 1)
arr(i, 1) = vSwap
End If
Next
End Sub
3、插⼊排序运作⽅式:
3.1、全部元素同样的分为有序区在前和⽆序区在后,开始时有序区仅有第⼀个元素。
3.2、取⽆序区的第⼀个元素,与有序区中元素由后⾄前扫描对⽐。
3.3、将该元素插⼊⾄正确位置,该位置(含)之后的有序区元素向后移位,将该位置赋值为该元素。
3.4、重复上述步骤,直⾄⽆序区仅剩⼀个元素
Sub InsertionSort(ByRef arr)
Dim i&, j&, vTemp
For i = 2To UBound(arr)
vTemp = arr(i, 1)
For j = i To2Step -1
If arr(j - 1, 1) < vTemp Then Exit For
arr(j, 1) = arr(j - 1, 1)
Next
arr(j, 1) = vTemp
Next
End Sub
4、快速排序运作⽅式:
快速排序与⼆叉查树基于⼀样的思路,采⽤了分治(Divide & Conquer)的策略。
4.1、选择⼀个元素作为⽐较的基准(Pivot)。
4.2、将所有元素与基准逐个对⽐,按所需顺序置于基准的两侧,如升序排列时⼤的放在基准右侧、⼩的放在左侧,将整个数据划分为左右两个分区。
4.3、视左右两个分区为两个单独的待排序数据,递归的重复上述操作,直⾄分区中元素只有⼀个。
取分区第⼀个元素作为基准的VBA实现,调⽤时 nLeft=LBound(arr): nRight=UBound(arr)
Sub QuickSort(ByRef arr, ByRef nLeft&, ByRef nRight&)
Dim i&, j&, vKey, vSwap
If nLeft >= nRight Then Exit Sub
vKey = arr(nLeft, 1)
i = nLeft + 1
j = nRight
Do
Do While i <= nRight
If arr(i, 1) > vKey Then Exit Do
i = i + 1
Loop
Do While j > nLeft
If arr(j, 1) < vKey Then Exit Do
j = j - 1
Loop
If i >= j Then Exit Do
vSwap = arr(i, 1): arr(i, 1) = arr(j, 1): arr(j, 1) = vSwap
Loop
If nLeft <> j Then
vSwap = arr(nLeft, 1): arr(nLeft, 1) = arr(j, 1): arr(j, 1) = vSwap
End If
If nLeft < j Then Call QuickSort(arr, nLeft, j)
If j + 1 < nRight Then Call QuickSort(arr, j + 1, nRight)
End Sub
5、希尔排序运作⽅式:
希尔排序是插⼊排序的⼀个优化。在插⼊排序中,每次对⽐是由后前逐个对⽐,或⾔对⽐的步长为1。
对⽐的步长可由⼤⾄⼩,直⾄步长为1变为插⼊排序。这样⼀来在最初的⼏个对⽐步长中,较⼩的元素(假设按升序排序)就会向⽬标位置前进⼀⼤步。
5.1、设置步长序列,由⼤⾄⼩。
5.2、由步长序列中,逐个获取步长。
5.3、由源数据中第步长+1个元素向后扫描,作为基准值。
5.4、由步骤3中的基准值元素向前扫描与基准值对⽐,并进⾏必要的位移,同时每次递减为步长⽽不是1。
5.5 、将基准值插⼊到正确的位置?
5.6、重复2、3、4、5,直⾄步长为1。
Sub ShellSort(ByRef arr)
Dim i&, j&, vTemp, aGaps, nGap, nLen&
aGaps = Array(701, 301, 132, 57, 23, 10, 4, 1)
nLen = UBound(arr)
For Each nGap In aGapsvba排序函数sort用法
For i = nGap + 1To nLen
vTemp = arr(i, 1)
For j = i To nGap + 1Step nGap * -1
If arr(j - nGap, 1) < vTemp Then Exit For
arr(j, 1) = arr(j - nGap, 1)
Next
arr(j, 1) = vTemp
Next
Next
End Sub