用VBA实现对一维数组的排序(3)插入排序

我不是专业码农，如有错误之处，请批评，谢谢~

插入排序很好理解，会斗地主就行，不管你是能猜到对手手牌高手，还是四个2四带二把对王甩出去只为打出气势的菜鸡，只要会摸牌理牌，那你一定会插入排序，因为插入排序的原理与你理牌的原理如出一辙.取一张牌,作为基准,新摸一张牌与其对比,插入正确位置,再摸牌,再与手里的所有牌对比,插入正确位置,如此往复,不废话,看图.

第一步:

我们把这一组数据当成一堆牌,先摸第一张牌11.然后摸第二张牌3,3与11对比,3小于11,将3与11调换位置,3放在上面.

第二步

再摸一张牌9与已经排好序的3与11对比,9小于11大于3,所以9放在第二行.11下移一位.

第三步

再摸一张牌2,与上面排好序的3,9.11对比,将大于2的部分下移,插入2

第四步

再摸一张4, 与上面排好序的2,3,9.11对比,将大于4的部分下移,插入4,提一点,当一旦发现某个数小于新摸出来的牌时,由于除了新摸得牌,其他摸出来的牌已经排好了序,所以可以判定后续的牌一定小于这张新牌,例如本例子中的3小于4,那么2就可以不再和4对比.

第五步

以此类推直至完成……

我们来来看看代码

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

Sub 插入排序原理演示()

Rem 插入排序这一组动作类似于扑克牌摸牌以后整理手里的拍 _

    其中第一个值是第一张牌，我们以此为参照，新摸到的牌 _

    与整理好的牌对比大小，选择一个前面大后面小的位置插 _

    入

Rem 我们将整个数据想象成一幅扑克牌,手里现在有一张牌(11) _

    摸到一张牌后就和手里的牌一一对比,发现某张牌小于新 _

    牌的时候就将对比过的牌一一往下面移动,字后再将新牌插入

Dim 牌堆计数器 As Integer, 新牌 As Integer, 手里牌计数器 As Integer

    For 牌堆计数器 = 2 To 24

Rem 这个循环是模拟的一张一张的摸牌动作

        新牌 = Range("a" & 牌堆计数器)

Rem 新牌记录下来,方面后面对比,移动数据的时候破坏掉了数据 _

    也能在通过记录找到这个数据取出填入适当的位置

            For 手里牌计数器 = 牌堆计数器 - 1 To 1 Step -1

            Union(Range("a" & 手里牌计数器), Range("a" & 牌堆计数器)).Select

                Range("a" & 手里牌计数器 + 1) = Range("a" & 手里牌计数器)

Rem 这里手牌直接一一覆盖前面的值,后面直接用新牌覆盖原来的值,在 _

    单元格里面就是单元格一一往下移动一个

                If Range("a" & 手里牌计数器) <= 新牌 Then

Rem 新牌与手中的牌对比,手牌有顺序,如果一旦新牌介于手牌之间的 _

    位置则无需再对比剩余手牌对比,此时for/手里牌这个循环就可以 _

    退出,不执行手牌移动,不退出的时候就一一移动,倒着循环方便移动

                    Exit For

                End If

            Next

        Range("a" & 手里牌计数器 + 1) = 新牌

Rem 最后一步是插入新牌到手牌堆里面,**注意这里的手里牌计数器其实记录的是 _

    最后一次数据下移的位置数据,所以需要加1.不然数据就会错位填入

    Next

End Sub

代码的执行过程不再单独演示,这里提供一个一维数组排序的模型,大家可以自己去调试

Function 数组插入排序模型(arr, 起点, 终点)

Dim 牌堆计数器 As Integer, 新牌 As Integer, 手里牌计数器 As Integer

    For 牌堆计数器 = 起点 + 1 To 终点

    新牌 = arr(牌堆计数器)

        For 手里牌计数器 = 牌堆计数器 - 1 To 起点 Step -1

            If arr(手里牌计数器) >= 新牌 Then

                Exit For

            End If

        arr(手里牌计数器 + 1) = arr(手里牌计数器)

        Next

    arr(手里牌计数器 + 1) = 新牌

    Next

    数组插入排序模型 = 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

Function 一维数组插入升序(arr, 起点, 终点)

Dim 牌堆计数器 As Integer, 新牌 As Integer, 手里牌计数器 As Integer

    For 牌堆计数器 = 起点 + 1 To 终点

    新牌 = arr(牌堆计数器)

        For 手里牌计数器 = 牌堆计数器 - 1 To 起点 Step -1

            If arr(手里牌计数器) <= 新牌 Then

                Exit For

            End If

        arr(手里牌计数器 + 1) = arr(手里牌计数器)

        Next

    arr(手里牌计数器 + 1) = 新牌

    Next

    一维数组插入升序 = arr

End Function

Function 一维数组插入降序(arr, 起点, 终点)

Dim 牌堆计数器 As Integer, 新牌 As Integer, 手里牌计数器 As Integer

    For 牌堆计数器 = 起点 + 1 To 终点

    新牌 = arr(牌堆计数器)

        For 手里牌计数器 = 牌堆计数器 - 1 To 起点 Step -1

            If arr(手里牌计数器) >= 新牌 Then

                Exit For

            End If

        arr(手里牌计数器 + 1) = arr(手里牌计数器)

        Next

    arr(手里牌计数器 + 1) = 新牌

    Next

    一维数组插入降序 = 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

Sub 多列插入测试()

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

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

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

End Sub

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

我们来说一下用法,与选择模块一样,传入同样的参数,结果相同:

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

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

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

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

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

使用教程图例

 

使用方法就在图中,在后面的排序中,我们依旧会将数组多列自由升序降序的函数封装成上面的样子,只不过就是调用的排序核心不同罢了.这样的批量制造能明显提升代码开发过程.明显减少代码的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

实验结果

使用方法就在图中,在后面的排序中,我们依旧会将数组多列自由升序降序的函数封装成上面的样子,只不过就是调用的排序核心不同罢了.这样的批量制造能明显提升代码开发过程.明显减少代码的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

销售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