我们平时用的表格排序，只相对来说是在在表格中的升序降序。今天就好奇如果数组中实现排序
他是怎么实现的呢。

经过一番折腾查找，真是一看吓一跳，真是感觉蚂蚁看大象，发现排序分为：

今天仅整理了最简单的两种排序。。。
先来看下定义和实现的方法吧。

选择排序（Selection sort）是一种简单直观的排序算法。它的工作原理是：第一次从待排序的数据元素中选出最小（或最大）的一个元素，存放在序列的起始位置，然后再从剩余的未排序元素中寻找到最小（大）元素，然后放到已排序的序列的末尾。以此类推，直到全部待排序的数据元素的个数为零。选择排序是不稳定的排序方法。

1.简单选择排序

Sub  选择排序()
Dim i, j, MinIndex As Integer
Dim MinValue As String
arr = Range("a1:a10")
 For i = 1 To UBound(arr)
    MinValue = arr(i, 1) '将第一个值先默认为最小值
    MinIndex = i         '记录最小值的索引位置
    For j = MinIndex + 1 To UBound(arr)
        If arr(j, 1) < MinValue Then
            MinValue = arr(j, 1)
            MinIndex = j
        End If
  	Next
    '以此和当前的最小值做对比，比较出后面的最小值并记录 值及索引的位置
    '因为小的值我们都放在最前面，所以遍历只需从当前值的后面开始就可以了，节省时间
    
    If MinIndex > i Then
        arr(MinIndex, 1) = arr(i, 1)
        arr(i, 1) = MinValue
    End If
    '这里的MinIndex和i的关系会有些绕，只会有两个可能，一种是MinIndex > i（在默认最小值的后面有比当前还小的值），另一种MinIndex = i ：（在最小值的后面没有找到比当前值的再小的）。
    '【不出现MinIndex < i的情况，只为理解，加不加基本没有影响】
 Next
[b1].Resize(UBound(arr), 1) = arr
End Sub

2.冒泡排序

原理：
1、比较相邻的元素。如果第一个比第二个大，就交换他们两个。
2、对每一对相邻元素做同样的工作，从开始第一对到结尾的最后一对。在这一点，最后的元素应该会是最大的数。
3、针对所有的元素重复以上的步骤，除了最后一个。
4、持续每次对越来越少的元素重复上面的步骤，直到没有任何一对数字需要比较。

Sub 冒泡排序()
arr = Range("a1:a10")
For j = 1 To UBound(arr)
    For i = 1 To UBound(arr) - 1
          If arr(i, 1) > arr(i + 1, 1) Then
            MinStr = arr(i + 1, 1)
            arr(i + 1, 1) = arr(i, 1)
            arr(i, 1) = MinStr
        End If
    Next
Next j
[b1].Resize(UBound(arr), 1) = arr
End Sub

类别	说明
选择排序	缺点：不稳定，具体怎么不问题不知道。。优点：速度要比冒泡排序快很多
冒泡排序	缺点：速度很慢。。优点：稳定

太多了 ，其他的

1，一维数组冒泡排序函数

Function bubble_sort(arr, Optional mode As String = "+")
    '函数定义bubble_sort(数组，排序模式)对一维数组数据进行排序，返回一个有序一维数组
    '2种排序模式，"+"即升序、"-"即降序
    Dim i As Long, j As Long, sorted As Boolean, temp, last_index, sort_border
    sort_border = UBound(arr) - 1  '排序边界，之后为有序，减少循环
    If mode = "+" Then
        For i = LBound(arr) To UBound(arr)
            sorted = True    '初始为有序，避免中途有序后的无效循环
            For j = LBound(arr) To sort_border
                If arr(j) > arr(j + 1) Then
                    sorted = False    '无序
                    temp = arr(j)     '交换数据
                    arr(j) = arr(j + 1): arr(j + 1) = temp
                    last_index = j    '最后排序的序号
                End If
            Next
            sort_border = last_index ': Debug.Print "sort_border", sort_border
            If sorted Then Exit For   '如果为有序，则退出循环
        Next
    ElseIf mode = "-" Then
        For i = LBound(arr) To UBound(arr)
            sorted = True    '初始为有序，避免中途有序后的无效循环
            For j = LBound(arr) To sort_border
                If arr(j) < arr(j + 1) Then
                    sorted = False    '无序
                    temp = arr(j)     '交换数据
                    arr(j) = arr(j + 1): arr(j + 1) = temp
                    last_index = j    '最后排序的序号
                End If
            Next
            sort_border = last_index ': Debug.Print "sort_border", sort_border
            If sorted Then Exit For   '如果为有序，则退出循环
        Next
    End If
    bubble_sort = arr
End Function

2，二维数组冒泡排序函数

Function bubble_sort_arr(arr, column As Integer, Optional mode As String = "+")
    '函数定义bubble_sort_arr(数组，排序列，排序模式)对二维数组数据的指定列进行排序，返回一个有序二维数组
    '2种排序模式，"+"即升序、"-"即降序
    Dim i As Long, j As Long, t As Long, sorted As Boolean, temp, last_index, sort_border
    ReDim temp(LBound(arr, 2) To UBound(arr, 2))
    sort_border = UBound(arr) - 1  '排序边界，之后为有序，减少循环
    If mode = "+" Then
        For i = LBound(arr) To UBound(arr)
            sorted = True    '初始为有序，避免中途有序后的无效循环
            For j = LBound(arr) To sort_border
                If arr(j, column) > arr(j + 1, column) Then
                    sorted = False    '无序
                    For t = LBound(arr, 2) To UBound(arr, 2)  '交换数据，数组整行
                        temp(t) = arr(j, t)
                        arr(j, t) = arr(j + 1, t): arr(j + 1, t) = temp(t)
                    Next
                    last_index = j    '最后排序的序号
                End If
            Next
            sort_border = last_index ': Debug.Print "sort_border", sort_border
            If sorted Then Exit For  '如果为有序，则退出循环
        Next
    ElseIf mode = "-" Then
        For i = LBound(arr) To UBound(arr)
            sorted = True    '初始为有序，避免中途有序后的无效循环
            For j = LBound(arr) To sort_border
                If arr(j, column) < arr(j + 1, column) Then
                    sorted = False    '无序
                    For t = LBound(arr, 2) To UBound(arr, 2)  '交换数据，数组整行
                        temp(t) = arr(j, t)
                        arr(j, t) = arr(j + 1, t): arr(j + 1, t) = temp(t)
                    Next
                    last_index = j    '最后排序的序号
                End If
            Next
            sort_border = last_index ': Debug.Print "sort_border", sort_border
            If sorted Then Exit For  '如果为有序，则退出循环
        Next
    End If
    bubble_sort_arr = arr
End Function

举例

《excel吧提问-按数字大小排序》，由于数据不规范、数字序号的位数不同，因此需要先对数据进行分割，然后调用函数排序
考虑到实际应用中可能存在不同年度，因此先对“执”字之前的内容排序，再分别对“执”字之前同样内容的“执”字之后的内容排序

Private Sub 排序测试()
    tm = Now()
    Dim arr, temp, brr, crr, result, i, j, k, first, last, write_col, write_row
'------参数填写
    write_col = "e"         '写入区域，列名，附加在列尾
    Cells(1, write_col).Value = "标题"
    arr = [b2:b19].Value
    ReDim Preserve arr(1 To UBound(arr), 1 To 3)
    For i = 1 To UBound(arr)
        temp = Split(arr(i, 1), "执")
        arr(i, 2) = temp(0): arr(i, 3) = Val(temp(1))  'val()提取文字前的数字
    Next
    brr = bubble_sort_arr(arr, 2, "+")  '对"执"之前的内容排序
    first = 1
    For j = 1 To UBound(brr) - 1
        If brr(j, 2) <> brr(j + 1, 2) Then  '对"执"之前的内容相等的排序
            last = j
            ReDim crr(1 To last - first + 1, 1 To 2)
            For k = first To last    '数组截取
                crr(k - first + 1, 1) = brr(k, 1): crr(k - first + 1, 2) = brr(k, 3)
            Next
            result = bubble_sort_arr(crr, 2, "+")
            write_row = Cells(1, write_col).CurrentRegion.Rows.count + 1
            Cells(write_row, write_col).Resize(UBound(result), 1) = result  '仅返回排序后的内容
        ElseIf j = UBound(brr) - 1 Then  '最后一组数据，无论单行多行
            last = UBound(brr)
            ReDim crr(1 To last - first + 1, 1 To 2)
            For k = first To last    '数组截取
                crr(k - first + 1, 1) = brr(k, 1): crr(k - first + 1, 2) = brr(k, 3)
            Next
            result = bubble_sort_arr(crr, 2, "+")
            write_row = Cells(1, write_col).CurrentRegion.Rows.count + 1
            Cells(write_row, write_col).Resize(UBound(result), 1) = result  '仅返回排序后的内容
            Exit For  '结束循环
        End If
        first = last + 1  '重置开始行
    Next
    Debug.Print ("排序完成，累计用时" & Format(Now() - tm, "hh:mm:ss"))  '耗时
End Sub

返回结果

参考资料：《冒泡排序》

       排序,是我们在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表下期我们会讲解其他的排序

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

实验数据：

 

排序结果：