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) To 2 Step -1
For j = 1 To 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
End Sub
2、选择排序运作方式:
2.1、对(无序区)全部元素由前至后扫描,找出最值。
2.2、将最值元素与(无序区)第一个元素交换,此时前端为有序区,后端为无序区。
2.3、重复上述步骤,直到无序区仅剩一个元素。
Sub SelectionSort(ByRef arr)
Dim i&, j&, vSwap, min&
For i = 1 To UBound(arr)
min = i
For j = i + 1 To UBound(arr)
If arr(min, 1) > arr(j, 1) Then min = j
If min <> i Then
vSwap = arr(min, 1)
arr(min, 1) = arr(i, 1)
arr(i, 1) = vSwap
End If
End Sub
3、插入排序运作方式:
3.1、全部元素同样的分为有序区在前和无序区在后,开始时有序区仅有第一个元素。
3.2、取无序区的第一个元素,与有序区中元素由后至前扫描对比。
3.3、将该元素插入至正确位置,该位置(含)之后的有序区元素向后移位,将该位置赋值为该元素。
3.4、重复上述步骤,直至无序区仅剩一个元素
Sub InsertionSort(ByRef arr)
Dim i&, j&, vTemp
For i = 2 To UBound(arr)
vTemp = arr(i, 1)
For j = i To 2 Step -1
If arr(j - 1, 1) < vTemp Then Exit For
arr(j, 1) = arr(j - 1, 1)
arr(j, 1) = vTemp
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 While i <= nRight
If arr(i, 1) > vKey Then Exit Do
i = i + 1
Do While j > nLeft
If arr(j, 1) < vKey Then Exit Do
j = j - 1
If i >= j Then Exit Do
vSwap = arr(i, 1): arr(i, 1) = arr(j, 1): arr(j, 1) = vSwap
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 aGaps
For i = nGap + 1 To nLen
vTemp = arr(i, 1)
For j = i To nGap + 1 Step nGap * -1
If arr(j - nGap, 1) < vTemp Then Exit For
arr(j, 1) = arr(j - nGap, 1)
arr(j, 1) = vTemp
End Sub