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

版权声明：本站内容均来自互联网，仅供演示用，请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系QQ:729038198，我们将在24小时内删除。