用VBA实现对一维数组的排序(2)选择排序

        前面发了一篇博文，我浪了，没说一件事儿：我不是专业的码农，我专业学的是医学，从事的是文员工作，我的工作内容需要用到大量的数据统计，所以我的博文必然是不够专业，但是代码我测试过是没有问题的，可以分享出来供大家参考以及批判！

       选择排序就一句话：第一轮数据中选出一个最小值，摆好,然后拿出来,第二轮在剩下的数据中再选出一个最小值,按顺序再摆,如此往复就可以完成排序

代码中，这个动作是怎么样子的呢？我们看看第一轮的对比

看图：

        第一步：我们设一个变量min（最小值），开始时用第一个数据11为最小值（min），然后一顺对比下来，发现更小的值1的时候变量min就等于这个更小的值1，把1拿出来，如此往复每一轮对比都能找到一个最小值。理论上,找到1以后应该将其拿出来,按顺序摆好也就是说在代码中我们需要再设置一个空的数组,用于接收拿出来的数据每一次拿出来的数据按序填装,如果数据少倒无所谓,但是如果数据大就会加大空闲复杂度,而且将数据”拿出来”,在代码里实现起来很复杂,看下图就明白为什么不可以找么做而是要对换位置了.

 

       所以我们如果是直接调换两个值的位置,这样做就很方便了,我们只需要改变下一轮循环的起始值就可以成功的实现”按序摆好”和”拿出来”两个需求.看上图找到最小值以后和第一个数字换一下位置这样一来我们，接下来我们看第二轮对比。

思考：第二轮对比一开始的时候我们应该假设谁为最小值（min）呢？

第二轮对比：在第二轮对比中，我们发现数组中的最小值“2”已经处在了自己的正确位置上，所以我们在第二轮对比及以后都可以不在对比他。那么第二轮对比以后我们会得到一个类似于第一轮一样的结果。

       第二轮对比：在第二轮对比中，我们发现数组中的最小值“2”已经处在了自己的正确位置上，所以我们在第二轮对比及以后都可以不在对比他。那么第二轮对比以后我们会得到一个类似于第一轮一样的结果。

第三轮对比：第三轮同样执行和第二轮一样的操作，只不过这一次不只是“1”和“2”排好位置 ，“3”也在正确位置上，所以第三轮有两个数字不用参与下一轮的对比

第四轮对比：第四轮对比开始的时候，有四个数字已经排好，这四个数字不再参与下一轮对比。

以此类推，每一轮对比都会减少一个数字参与对比，具体看图（标红）    

我们观察前四轮对比，每一轮对比都会有相对最小的数据排好序。

以上就是选择排序的整个运动过程。

在代码中我们如何实现以上功能呢？

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

‘代码实现

Sub 选择排序原理演示()

Rem 原理是选出最小的方第一个(或末尾),剩余部分继续执行该操作

Rem 难点:如何选出最小元素,替换后位置后,如何确定剩余部分区域

Dim i As Integer, 动态起始值 As Integer

Dim 临时存储, 对比值, 最小值行号

    For k = 1 To 24

        对比值 = Range("a" & k)

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

Rem 假设一个对比值,然后循环对比

        动态起始值 = 动态起始值 + 1

        For i = 动态起始值 To 24

Rem 动态起始值的累加,使得for i 循环每轮都会缩小一格区域

        Union(Range("a" & k), Range("a" & i)).Select

        Debug.Print 对比值

            If 对比值 >= Range("a" & i) Then

                对比值 = Range("a" & i)

Rem 刷新最小值,接着对比,直到找不出更小的值

                最小值行号 = Range("a" & i).Row

Rem 循环结束依旧可以通过行号记录追溯到该单元格

            End If

        Next i

        Range("a" & k) = Range("a" & 最小值行号)

        Range("a" & 最小值行号) = 临时存储

Rem 利用临时存储和行号记录替换单元格

    Next k

End Sub

代码讲解（1）：

通过改变for I 循环的起始值，我们可以改变对比的范围。

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

以上是单元格操作的示例

现在我将数组排序的代码放出，这是一个模型，我们可以通过修改模型来封装自己的函数

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

‘用法：在括号里填入排序地址，是可以实现在数组内排序的。输出部分我推荐学习郑广学老师的课程，有专门的数组输出基础课。

Sub 数组选择排序模型(排序地址)

Dim i As Integer, 动态起始值 As Integer

Dim 临时存储, 对比值, 最小值行号，arr

    arr = Range(排序地址)

    For k = 1 To UBound(arr, 1)

        对比值 = arr(k, 1)

        临时存储 = arr(k, 1)

Rem 假设一个对比值,然后循环对比

        动态起始值 = 动态起始值 + 1

        For i = 动态起始值 To UBound(arr, 1)

Rem 动态起始值的累加,使得for i 循环每轮都会缩小一格区域

            If 对比值 >= arr(i, 1) Then

                对比值 = arr(i, 1)

Rem 刷新最小值,接着对比,直到找不出更小的值

                最小值行号 = i

Rem 循环结束依旧可以通过行号记录追溯到该单元格

            End If

        Next i

        arr(k, 1) = arr(最小值行号, 1)

        arr(最小值行号, 1) = 临时存储

Rem 利用临时存储和行号记录替换单元格

    Next k

End Sub

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

题外话：选择排序，是一种不稳定排序，也就是说相同大小的数据是存在对调位置的情况的。用的时候必须要小心这一点。但是在我封装的函数里,我利用字典规避了这个问题,同时又能多列同时排序,支持不同列自由选择升序降序.

下面我们来看这个函数是如何封装的,现在我们”故技重施”!一招鲜吃遍天(这个在” 利用一维数组排序实现二维数组的多列自由升降序函数封装的详解”这一章里面讲过).

Function 数组选择排序升序(arr, 起始行, 终止行)

Dim i As Integer, 动态起始值 As Integer

Dim 临时存储, 对比值, 最小值行号

    动态起始值 = 起始行

    For k = 起始行 To 终止行

        对比值 = arr(k)

        临时存储 = arr(k)

        For i = 动态起始值 To 终止行

            If 对比值 >= arr(i) Then

                对比值 = arr(i)

                最小值行号 = i

            End If

        Next i

        动态起始值 = 动态起始值 + 1

        arr(k) = 对比值

        arr(最小值行号) = 临时存储

    Next k

    数组选择排序升序 = arr

End Function

Function 数组选择排序降序(arr, 起始行, 终止行)

Dim i As Integer, 动态起始值 As Integer

Dim 临时存储, 对比值, 最小值行号

    动态起始值 = 起始行

    For k = 起始行 To 终止行

        对比值 = arr(k)

        临时存储 = arr(k)

        For i = 动态起始值 To 终止行

            If 对比值 <= arr(i) Then

                对比值 = arr(i)

                最小值行号 = i

            End If

        Next i

        动态起始值 = 动态起始值 + 1

        arr(k) = 对比值

        arr(最小值行号) = 临时存储

    Next k

    数组选择排序降序 = arr

End Function

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 升降 As Boolean

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))

    Next

    g = 起点

    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

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

‘这一段是测试代码,在原来的excel表里面有测试区

Sub 多列选择测试()

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

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

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

End Sub

我们来说一下用法:

函数: 多列选择排序模块(arr, 值列串, 起点, 终点, Optional 递推 = 0)

他有五个参数:其中最后一个参数不需要填入,为内置参数,默认为0,在递归过程中他会递增,不明白递归的话,可以去看” 利用一维数组排序实现二维数组的多列自由升降序函数封装的详解”这一节.

必填参数:arr指需要排序的数组(二维数组)

必填参数:值列串指排序列的列号,在数组中那几列需要排序.例如图:”使用教程图例”中的说明,

必填参数: 起点, 终点指的是需要排序部分的起始行和终止行

使用教程图例

 这是利用excel模拟的二维数组.代码贴在了旁边

使用方法就在图中,在后面的排序中,我们依旧会将数组多列自由升序降序的函数封装成上面的样子,只不过就是调用的排序核心不同罢了.这样的批量制造能明显提升代码开发过程.明显减少代码的bug出现的频率.这一点在郑广学老师的课程里有明显体现:设计函数的思路,以及对函数的大类方向,常用函数的整理都在郑老师的课程中课程中有体现.

实验数据

销售TOP50统计表
序号	姓名	性别	年龄	工作年限	销售组	销售额(万）
1	工号01	女	22	5	3	21
2	工号02	女	32	5	3	44
3	工号03	男	22	5	3	13
4	工号04	女	29	2	1	17
5	工号05	男	22	5	4	13
6	工号06	男	21	10	3	45
7	工号07	女	26	9	2	30
8	工号08	女	22	5	1	10
9	工号09	男	22	1	4	12
10	工号010	男	20	1	2	31
11	工号011	男	22	5	3	10
12	工号012	女	27	2	1	40
13	工号013	男	26	9	1	11
14	工号014	女	22	8	4	34
15	工号015	男	21	6	2	50
16	工号016	男	30	2	2	29
17	工号017	男	22	6	1	44
18	工号018	男	29	5	2	31
19	工号019	男	20	2	3	37
20	工号020	男	22	5	3	41
21	工号021	男	28	10	3	33
22	工号022	男	33	9	2	23
23	工号023	男	22	8	2	45
24	工号024	男	24	1	2	14
25	工号025	女	20	1	4	19
26	工号026	女	22	7	1	40
27	工号027	女	29	2	2	22
28	工号028	男	32	8	4	48
29	工号029	男	22	5	2	28
30	工号030	女	35	1	1	26
31	工号031	女	31	7	3	26
32	工号032	女	32	6	4	45
33	工号033	男	32	6	1	48
34	工号034	女	22	8	3	40
35	工号035	男	29	6	4	49
36	工号036	男	32	6	4	42
37	工号037	男	22	5	2	43
38	工号038	女	28	3	1	50
39	工号039	男	25	2	4	35
40	工号040	男	22	4	3	36
41	工号041	男	29	3	3	42
42	工号042	男	34	2	3	35
43	工号043	男	33	5	3	39
44	工号044	男	33	4	4	43
45	工号045	男	21	6	1	40
46	工号046	女	22	5	4	31
47	工号047	女	29	4	3	32
48	工号048	女	32	6	1	39
49	工号049	女	27	3	1	37
50	工号050	男	23	2	2	41

实验结果

销售TOP50统计表
序号	姓名	性别	年龄	工作年限	销售组	销售额(万）
19	工号019	男	20	2	3	37
10	工号010	男	20	1	2	31
25	工号025	女	20	1	4	19
6	工号06	男	21	10	3	45
45	工号045	男	21	6	1	40
15	工号015	男	21	6	2	50
23	工号023	男	22	8	2	45
34	工号034	女	22	8	3	40
14	工号014	女	22	8	4	34
26	工号026	女	22	7	1	40
17	工号017	男	22	6	1	44
8	工号08	女	22	5	1	10
37	工号037	男	22	5	2	43
29	工号029	男	22	5	2	28
20	工号020	男	22	5	3	41
1	工号01	女	22	5	3	21
3	工号03	男	22	5	3	13
11	工号011	男	22	5	3	10
46	工号046	女	22	5	4	31
5	工号05	男	22	5	4	13
40	工号040	男	22	4	3	36
9	工号09	男	22	1	4	12
50	工号050	男	23	2	2	41
24	工号024	男	24	1	2	14
39	工号039	男	25	2	4	35
13	工号013	男	26	9	1	11
7	工号07	女	26	9	2	30
49	工号049	女	27	3	1	37
12	工号012	女	27	2	1	40
21	工号021	男	28	10	3	33
38	工号038	女	28	3	1	50
35	工号035	男	29	6	4	49
18	工号018	男	29	5	2	31
47	工号047	女	29	4	3	32
41	工号041	男	29	3	3	42
4	工号04	女	29	2	1	17
27	工号027	女	29	2	2	22
16	工号016	男	30	2	2	29
31	工号031	女	31	7	3	26
28	工号028	男	32	8	4	48
33	工号033	男	32	6	1	48
48	工号048	女	32	6	1	39
32	工号032	女	32	6	4	45
36	工号036	男	32	6	4	42
2	工号02	女	32	5	3	44
22	工号022	男	33	9	2	23
43	工号043	男	33	5	3	39
44	工号044	男	33	4	4	43
42	工号042	男	34	2	3	35
30	工号030	女	35	1	1	26