用VBA实现对一维数组的排序(1)冒泡排序

       排序,是我们在Excel中最常用的一种功能,一般情况下单元格有sort排序.但是在数组中VBA没有提供类sort方法用于排序.现在为了探究数组内排序的方法,我特意整理的一下VBA数组内排序的笔记分享给大家(如果是高手请无视).有不少地方将数组排序分成七种,十种,十五种,二十五种甚至有五十多种,但无论是几种排序,其实都是以冒泡排序,选择排序,插入排序,希尔排序,归并排序,快速排序,堆排序,桶排序,计数排序,基数排序十种方式为基础的不理解这些基础,后面的排序很难以理解.由于桶排序,基数排序和计数排序是非比较排序,在文本字符串方便处理起来较为复杂,这里不讲.我们只讲除此之外的七种排序,无论数字和文本都能直接调用.

冒泡排序原理阐述: 冒泡排序的原理是相邻的数据两两对比互换位置,经过多轮两两对比的循环操作就可以实现排序.

冒泡排序的动作原理演示:

冒泡排序说明:每一轮都从上至下相邻元素两两对比,如果小值在上大值在下则对调,否则不对调位置(降序),经过多轮对比对调就可完成排序,看图.

数据: 11 3 9 2 4 5 6 1 10 8 7 7 5 10 13 15 16 14 17 19 18 22 10 20,排序

我们将冒泡排序分步拆解画图来观察他的原理演示.

第一步, 3和11对比,3>11,小数在下,不对调位置,看图 

第二步, 3与9对比,3<9,小数在上,对调位置,换句话说就是小值往下沉.

第三步:……

        注意观察：上图是第一轮的过程示意图,看图我们发现经过第一轮两两对比最小值1被推到了最下面，这是偶然吗？不妨看看每一轮两两对比的最后一步

答案在这里：

因为,每一轮对比过程,我们可以将未排好序的最小值对比出来,而排好序的已经就位,可以不需要再次对比,按照相邻元素两两对比，上面的小值与小面的大值对调位置的原则，最小值永远都会下沉, 

冒泡排序总结:从上到下两两对比,如果从上到下一轮不够,那就再来几轮,直到完成排序，每次排序几乎都能将一个最大值或者最小值上浮或者下沉到自己的位置上

演示代码:

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

Sub 冒泡排序原理演示()

Rem 冒泡排序的原理是相邻的两两对比互换位置,经过多轮循环两两对比就可以实现排序

Rem 难点:理解如何缩短循环过程

    Dim i As Integer,临时存储

最大行 = 24

    Do

        For i = 2 To 最大行 '构建循环,相邻 单元格进行对比符合条件就互换

    Rem 循环的时候要注意循环起始值需要加1,否则Range("a" & i - 1)会报错

        Union(Range("a" & i), Range("a" & i - 1)).Select

    Rem 组合单元格选定,观察程序执行情况

            If Range("a" & i) > Range("a" & i - 1) Then

    Rem 对比相邻单元格

                临时存储 = Range("a" & i - 1)

    Rem 设置一个临时储存,记录初始值,因为不能同时替换,所以必须记录初始值, 否则数据会错乱,不理解的朋友可以调试执行试试

                Range("a" & i - 1) = Range("a" & i)

    Rem 先替换Range("a" & i - 1) = Range("a" & i),此时Range("a" & i - 1)原值被破坏 , 原值备份在临时存储里

                Range("a" & i) = 临时存储

    Rem Range("a" & i)此时不能等于Range("a" & i - 1),因为原值被破坏,只能从临时存储中取出备份数据,这就是;临时储存存在的意义和设置目的

            End If

        Next i

        最大行 = 最大行 - 1

    Rem 每次执行，都会将最大值（最小值）推到边界上面，所以我们让最大行递减

    Loop While 最大行 > 0

End Sub

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

注：在代码中每一轮两两对比一次我们就将最大行递减一次，for循环就缩短一轮

数组排序的代码可以根据需求自己修改

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

数组排序代码模型:

Function 数组冒泡排序模型(arr, 起点, 终点)

Rem 可以更改数组为二维数组 , 每次将其他列数据利用& ","& 符号连接 , 然后将数据放_入第二列,第一列排序替换位置的 时候第二列也替换,输出是利用split函数拆分输出即可

    最大行 = 终点

    Do

        For i = 终点 To 起点 + 1 Step -1

            If arr(i - 1) > arr(i) Then

Rem 更换"<"或">"符号即可切换升序降序

                临时储存 = arr(i - 1)

Rem 临时存储是一个变量,随时更换

                arr(i - 1) = arr(i)

                arr(i) = 临时储存

Rem 数组元素对比后满足条件就值互换位置

            End If

        Next i

    最大行 = 最大行 - 1

    Loop While 最大行 > 0

    数组冒泡排序模型 = arr

End Function

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

我们现在来看看数组模型的测试结果如何

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

Sub 冒排测试()

Dim arr()

arr = Array(10, 22, 32, 1, 12, 18, 30, 45, 22, 30, 30, 80, 55, 96, 69, 46, 49, 92, 42, 71, 2, 3, 14, 15, 10, 0, 100)

数组冒泡排序模型 arr, 0, 26

End Sub

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

在end’ sub 设置断点，方便监视窗口查看结果

 

 执行代码，监视窗口查看arr

 

我们观察到代码执行效果，一维数组已经排好序了

这里要提醒一点，我们不是专业的程序员，不需要对时间复杂度，空间复杂度和稳定性做过多的研究，但是我们自己要大概知道这是什么东西

时间复杂度和空间复杂度可以大致理解为：所需的时间和内存对比可以自由选择排序方法

稳定性：相同元素的相对位置是否变化。

我们可以观察到冒泡排序是一种稳定的排序，排序方式上面他不需要在自定义一个数组，在数组内部就可以调换，说人话就是使用这种方式不需要在另外再在电脑内存条里专门给他整个位置出来，这种情况一般我们不需要考虑，电脑跑一分钟和一秒钟对于我们而言没区别。我们需要考虑的是稳定性，同样一个元素，调换位置以后对排序结果有没有影响，如果有，我们就需要考虑更换排序方式或者将排序更换为多列排序，增加排序的主次。

桶排序，基数排序，计数排序由于对字符串的处理很复杂，所以我不做研究。除此三种以外的七种排序方式在VBA中是绝对够用的。

关于冒泡排序函数的封装：

首先我们明确代码设计思路:我们已经有了一维数组的排序,那么二维数组多列排序该怎么办?很简单,一维数组排序好以后,记录行号,再利用行号修改数组即可.其次排序不稳定会造成相等元素的相对位置发生变化,比如上面的10会和下面的10发生位置互换,单列还好,但多数情况下我们都是在处理多列数据,相对位置的变化会造成一定的麻烦.为此我特地想到了一个既能记录行号又能避免不稳定的东西---------字典.

字典两个特性:去重复以及一对一对应.当遇到相同的值我们可以利用dic(key) = item 的特点取出与key 对应的item,然后利用”&”符号连接新的item,如此一来循环录入字典的时候,相同的值会被集中到一起,并且相对位置不会改变,利用行号统一输出的时候恰好就避免了不稳定的问题,同时能记录行号,而字典的keys是一个一维数组,再利用前面的模块,正好就能排序.

设计代码的时候我考虑为了节约写代码的时间,所以其实将一维数组排序都写成了模块,在多列排序里面我引用了他,七个排序都可以直接使用,这里我推荐郑广学老师(excel880网站站长)的课程,这招跟他学的,好处是提高写代码的效率,同时又避免了代码太长遇到bug长时间无法调试好的风险.但是也有一定难度.初学者不容易实现.

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

‘由于调试复杂这里只说函数如何使用,不另行调试

‘这是字典模块,字典模块用于集合相同项避免不稳定,记录行号便于行与行替换

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, 起点, 终点)

Rem 可以更改数组为二维数组 , 每次将其他列数据利用& ","& _

    符号连接 , 然后将数据放入第二列,第一列排序替换位置的 _

    时候第二列也替换,输出是利用split函数拆分输出即可

    最大行 = 终点

    Do

        For i = 终点 To 起点 + 1 Step -1

            If arr(i - 1) > arr(i) Then

Rem 更换"<"或">"符号即可切换升序降序

                临时储存 = arr(i - 1)

Rem 临时存储是一个变量,随时更换

                arr(i - 1) = arr(i)

                arr(i) = 临时储存

Rem 数组元素对比后满足条件就值互换位置

            End If

        Next i

    最大行 = 最大行 - 1

    Loop While 最大行 > 0

    一维数组冒泡升序 = arr

End Function

‘一维数组降序模块

Private Function 一维数组冒泡降序(arr, 起点, 终点)

Rem 可以更改数组为二维数组 , 每次将其他列数据利用& ","& _

    符号连接 , 然后将数据放入第二列,第一列排序替换位置的 _

    时候第二列也替换,输出是利用split函数拆分输出即可

    最大行 = 终点

    Do

        For i = 终点 To 起点 + 1 Step -1

            If arr(i - 1) < arr(i) Then

Rem 更换"<"或">"符号即可切换升序降序

                临时储存 = arr(i - 1)

Rem 临时存储是一个变量,随时更换

                arr(i - 1) = arr(i)

                arr(i) = 临时储存

Rem 数组元素对比后满足条件就值互换位置

            End If

        Next i

    最大行 = 最大行 - 1

    Loop While 最大行 > 0

    一维数组冒泡降序 = 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

Rem 最后将其输出出来,覆盖掉原来数组中的排序的局部区域

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

 ‘用法如下

函数:多列冒泡修整数组(数组arr  ,  “+4,-5,+6,-7” , 起始行 , 终止行)

参数说明:

(1)数组arr:需要排序的数组

(2):排序主次列,引号内主列-次列-次次列,为避免代码出现栈溢出,我做了限制,最多支持8行数据的排序

(3)起始行与终止行:数组需要排序部分的起始行和终止行,如第三行开始到52行这个区域需要排序,起始行就是3,终止行就是52

备注:本函数支持数组局部排序.此功能常用于表头部分不参与排序的情况

事例以及上述代码的测试

1. Sub 多列冒泡测试()
2. arr = Sheet6.Range("a1:g52")
3. 多列冒泡排序模块 arr, "+4,-5,+6,-7", 3, 52
4. Sheet6.Range("j1").Resize(52, 7) = arr '输出检验点
5. End Sub

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

具体排序测试数据,我会提供专门的EXCEL表下期我们会讲解其他的排序

最后附上数据,与排序结果

实验数据：

 

排序结果：