用VBA实现对一维数组的排序(6)快速排序

快速排序是最常见的排序之一,其排序方式容易理解,排序代码也容易实现,排序速度快,很受欢迎.

首先在了解快速排序之前我们先了解一下冒泡排序,冒泡排序是相邻元素之间两两对比,按小数前大数后的规律调整两数的位置,经过多轮对比以后,即可完成排序.宏观来看,其实就是大数往后小数往前的一种排序方式,微观上冒泡排序是一个个的对比.快速排序是冒泡排序的改进版型,快速排序其实是将整个数据串以一个基准点分成大小两边,宏观上看也是大数往后小数往前,微观上,快排相对于冒泡一个个的对比而言是一种”批量操作”了.

现在我们来看看快速排序是怎么做的批量操作的:

首先我们将:2 6 10 22 3 3 5 20 7排个序

第一步我们需要选一个参照物,理论上数组里面随便哪一个都行,但是为了方便我们一般我们都取头部的元素(2)或者尾部的元素(7)这里我们取尾部的元素作为参照的基准数7.

第二步设置两个变量:”右递推_K”和”左递推_D”,一个在最左边,一个在最右边(把参照值排除在外)他俩干嘛的呢?他俩用来记录位置的.看第三步就知道了

第三步先对比参考值和”右递推_K”指向的数字,如果小于等于参照值就往右移动一格,然后接着对比,否则停止移动,一旦”右递推_K”停止移动,他就和”左递推_D”指向的数据对换, ”

这是第一轮根据参照物将数据以7为界,分成了左右两个区,左边的都小于7右边的都大于7.

接下来在将左右两个区继续上述动作,这个操作是不是很熟悉呢?没错递归.

看图

接下来,我们看看第三轮排序

 

所以为什么说他是冒泡排序的改进型,原因就在这里

    我们观察一下本文第一张图,7到达自己的位置花了7步,如果是冒泡排序呢?大家不妨计算一下,这里不再累述.

关于递归,在归并排序中讲了很多,现在不再累述.

***********************************************************

Function 单轮排序(arr, 起始值, 结束值)

Dim 右_k As Integer, 左_d As Integer, 临时存储

Rem 设置往左往右的递推变量,用以记录递推

    右_k = 起始值: 左_d = 结束值 - 1: 参照值 = arr(结束值)

Rem 定下各个起点和参照物的具有值

    While 右_k <> 左_d

Rem 递推值相碰撞之前一直执行

        临时存储 = arr(左_d)

        If arr(右_k) <= 参照值 Then

            右_k = 右_k + 1

Rem 当左边的数据小于等于参照的时候,左边递推一步,右边不动

        Else

            arr(左_d) = arr(右_k)

            arr(右_k) = 临时存储

            左_d = 左_d - 1

Rem 当左边的数据大于参照的时候,左边递推停止右边递推一步并更换数据

        End If

    Wend

    If arr(左_d) <= 参照值 Then

        arr(结束值) = arr(左_d + 1)

        arr(左_d + 1) = 参照值

    Else

        arr(结束值) = arr(左_d)

        arr(左_d) = 参照值

    End If

Rem 当右_k =左_d,最后内部更换参照值和又区域的第一个值

    单轮排序 = 左_d

Rem 递推结果输出,要注意,这一点很重要,将支持递归的运行

End Function

Sub 单轮排序测试()

arr = Array(2, 60, 10, 22, 3, 3, 5, 30, 7)

Rem Array(2, 6, 10, 22, 3, 8, 5, 20, 7) 和 Array(2, 6, 10, 22, 8, 3, 5, 20, 7)测试 _

    边界极值测试也通过了

s = 单轮排序(arr, 0, 8)

Rem 经过测试发现,我们可以取出边界值,能将参数传入递归函数,其次数据内部已经排好了顺序

End Sub

Function 递归快排(arr, 数组起始, 数组结束)

Dim s As Integer

    If 数组结束 > 数组起始 Then

        s = 单轮排序(arr, 数组起始, 数组结束)

        递归快排 arr, 数组起始, s

Rem 将数组分为前后两节,而分开的节点其实是参照物的位置,而在上面的函数里面其实已经输出了

        递归快排 arr, s + 1, 数组结束

    End If

Rem 这里说一下这个递归事例,和归并的例子如出一辙,其实这个递归模型很简单,不停的引用自己,变化的 _

    则是参数,而每一次新求出来的参数则是通过"递归快排"函数内部求出.模型很简单,稍微理解一下就可以用

    递归快排 = arr

End Function

Sub 整体测试()

    arr = Array(2, 6, 10, 22, 3, 3, 5, 20, 7)

    递归快排 arr, LBound(arr), UBound(arr)

End Sub

Rem 以上是单轴快排序.其实还有双轴快排和三向切分快排,单轴最为简单,在这里引做事例 _

其他的快排感兴趣的朋友可以自己去网上搜索一下,这里提供了案例和模型,大家可以根据自己需求修改

***********************************************************

以上是一维数组的快速排序,大家可以拿去做测试下面我分享一下二维数组多列自由升降序的排序函数以及其用法

***********************************************************

Private Function 行号记录字典(All, 值列, 数组索引起点, 数组索引终点, Optional 功能 = 0)

    Dim dic '创建字典，采用引用法

    Set dic = CreateObject("Scripting.Dictionary")

    'Dim Dic As New Dictionary '(勾选引用法)

    For i = 数组索引起点 To 数组索引终点

        key = All(i, 值列)

        If dic.Exists(key) = False Then

            Rem 不存在key的时候item就等于i,避免下面的 xxx & xxx 录入一个空值

            dic(key) = i

        Else

            dic(key) = dic(key) & "=*=" & i

        End If

    Next

    Rem 根据功能选择输出

    If 功能 = 0 Then

        行号记录字典 = dic.keys '输出字典

    ElseIf 功能 = 1 Then

        行号记录字典 = dic.Items '输出值列

    Else

        Set 行号记录字典 = dic '输出关键字列

    End If

End Function

Private Function 单轮快速降序(arr, 起始值, 结束值)

    Dim 右_k As Integer, 左_d As Integer, 临时存储

    右_k = 起始值: 左_d = 结束值 - 1: 参照值 = arr(结束值)

    While 右_k <> 左_d

        临时存储 = arr(左_d)

        If arr(右_k) >= 参照值 Then

            右_k = 右_k + 1

        Else

            arr(左_d) = arr(右_k)

            arr(右_k) = 临时存储

            左_d = 左_d - 1

        End If

        Wend

        If arr(左_d) >= 参照值 Then

            arr(结束值) = arr(左_d + 1)

            arr(左_d + 1) = 参照值

        Else

            arr(结束值) = arr(左_d)

            arr(左_d) = 参照值

        End If

        单轮快速降序 = 左_d

    End Function

Private Function 单轮快速升序(arr, 起始值, 结束值)

    Dim 右_k As Integer, 左_d As Integer, 临时存储

    Rem 设置往左往右的递推变量,用以记录递推

    右_k = 起始值: 左_d = 结束值 - 1: 参照值 = arr(结束值)

    Rem 定下各个起点和参照物的具有值

    While 右_k <> 左_d

        Rem 递推值相碰撞之前一直执行

        临时存储 = arr(左_d)

        If arr(右_k) <= 参照值 Then

            右_k = 右_k + 1

            Rem 当左边的数据小于等于参照的时候,左边递推一步,右边不动

        Else

            arr(左_d) = arr(右_k)

            arr(右_k) = 临时存储

            左_d = 左_d - 1

            Rem 当左边的数据大于参照的时候,左边递推停止右边递推一步并更换数据

        End If

        Wend

        If arr(左_d) <= 参照值 Then

            arr(结束值) = arr(左_d + 1)

            arr(左_d + 1) = 参照值

        Else

            arr(结束值) = arr(左_d)

            arr(左_d) = 参照值

        End If

        Rem 当右_k =左_d,最后内部更换参照值和又区域的第一个值

        单轮快速升序 = 左_d

        Rem 递推结果输出,要注意,这一点很重要,将支持递归的运行

    End Function

Private Function 一维数组快速升序(arr, 数组起始, 数组结束)

    Dim s As Integer

    If 数组结束 > 数组起始 Then

        s = 单轮快速升序(arr, 数组起始, 数组结束)

        一维数组快速升序 arr, 数组起始, s

        一维数组快速升序 arr, s + 1, 数组结束

    End If

    一维数组快速升序 = arr

End Function

Private Function 一维数组快速降序(arr, 数组起始, 数组结束)

    Dim s As Integer

    If 数组结束 > 数组起始 Then

        s = 单轮快速降序(arr, 数组起始, 数组结束)

        一维数组快速降序 arr, 数组起始, s

        一维数组快速降序 arr, s + 1, 数组结束

    End If

    一维数组快速降序 = arr

End Function

'这是多列排序的另外两个模块

Private Function 单列快速排序模块(arr, 值列, 起点, 终点)

    Dim 升降 As Boolean

    Rem 判断升序降序,修整数据

    If 值列 < 0 Then

        值列 = Abs(值列)

        升降 = False

    ElseIf 值列 > 0 Then

        值列 = Abs(值列)

        升降 = True

    End If

    ReDim arr_son(起点 To 终点, LBound(arr, 2) To UBound(arr, 2))

    Set dic = 行号记录字典(arr, 值列, 起点, 终点, 3)

    arr_rows = dic.keys '取出关键字排序

    If 升降 = True Then

        arr_rows = 一维数组快速升序(arr_rows, LBound(arr_rows), UBound(arr_rows))

    Else

        arr_rows = 一维数组快速降序(arr_rows, LBound(arr_rows), UBound(arr_rows))

    End If

    ReDim brr(LBound(arr_rows) To UBound(arr_rows))

    For i = LBound(arr_rows) To UBound(arr_rows)

        brr(i) = dic(arr_rows(i)) '首先按排好序的key,取出排好序的item

    Next

    g = 起点 '将排好序的数据导入arr_son数组,做好覆盖前的准备

    For i = LBound(brr) To UBound(brr)

        crr = Split(brr(i), "=*=")

        For t = LBound(crr) To UBound(crr)

            For h = LBound(arr, 2) To UBound(arr, 2)

                arr_son(g, h) = arr(Abs(crr(t)), h)

            Next

            g = g + 1

        Next

    Next

    For i = 起点 To 终点 '另外构建一个数组,填入部分需要修改的数据,最后覆盖

        For t = LBound(arr, 2) To UBound(arr, 2)

            arr(i, t) = arr_son(i, t)

        Next

    Next

    'Sheet6.Range("j1").Resize(52, 7) = arr '输出检验点

End Function

Private Function 多列快速排序模块(arr, 值列串, 起点, 终点, Optional 递推 = 0)

    arr_值组 = Split(值列串, ",")

    s = UBound(arr_值组)

    If 递推 > s Then Exit Function

    If 递推 > 5 Then Exit Function

    单列快速排序模块 arr, Val(arr_值组(递推)), 起点, 终点

    brr = 行号记录字典(arr, Abs(arr_值组(递推)), 起点, 终点, 1)

    For t = LBound(brr) To UBound(brr)

        crr = Split(brr(t), "=*=")

        If UBound(crr) > 0 Then

            多列快速排序模块 arr, 值列串, crr(LBound(crr)), crr(UBound(crr)), 递推 + 1

        End If

    Next

End Function

Sub 多列快排测试()

    arr = Sheet6.Range("a1:g52")

    多列快速排序模块 arr, "+4,-5,+6,-7", 3, 52

    Sheet6.Range("j1").Resize(52, 7) = arr '输出检验点

End Sub

***********************************************************

用法:

所有代码复制到excel的模块中

引用函数”多列归并排序模块”

多列快速排序模块(arr, 值列串, 起点, 终点, Optional 递推 = 0)

有五个参数,第五个参数不需要赋值,否则会出bug

第一参数:需要排序的数组

第二参数:排序的主次列,以"+4,-5,+6,-7"的形式输入,详细使用案例参看测试代码,其中”+”代表升序”-”代表降序,”+4,-5”的意思是主列4列升序次列5列降序

第三参数:数组需要排序的起始行

第四参数:数组需要排序的终止行

使用案例:测试代码

Sub 多列归并测试()

arr = Sheet6.Range("a1:g52")

多列快速排序模块 arr, "+4,-5,+6,-7", 3, 52

Sheet6.Range("i1").Resize(52, 7) = arr

End Sub

测试数据结果都在我上传的演示excel表里面，可以免费下载