如何利用一维数组实现二维数组的多列自由升降序排序过程详解

如何利用一维数组实现二维数组的多列自由升降序排序过程详解

本例只说明多列排序的实现方式,一维数组的排序已经有过讲解不在赘述.所以本文是在已经完成了一维数组排序的函数封装的基础上完善多列排序的过程的详解.

这里先提供一段快速排序的代码用于作为案例说明

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

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

Dim dic

    Set dic = CreateObject("Scripting.Dictionary")

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

        key = Abs(All(i, 值列))

        If dic.Exists(key) = False Then

            dic(key) = i

        Else

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

        End If

    Next

    If 功能 = 0 Then

        行号记录字典 = dic.keys

    ElseIf 功能 = 1 Then

        行号记录字典 = dic.Items

    Else

        Set 行号记录字典 = dic

    End If

End Function

______________________________________________________________________________________________________

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

    最大行 = 终点

    Do

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

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

                临时储存 = arr(i - 1)

                arr(i - 1) = arr(i)

                arr(i) = 临时储存

            End If

        Next i

    最大行 = 最大行 - 1

    Loop While 最大行 > 0

    一维数组冒泡升序 = arr

End Function

______________________________________________________________________________________________________

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

    最大行 = 终点

    Do

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

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

                临时储存 = arr(i - 1)

                arr(i - 1) = arr(i)

                arr(i) = 临时储存

            End If

        Next i

    最大行 = 最大行 - 1

    Loop While 最大行 > 0

    一维数组冒泡降序 = arr

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

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

______________________________________________________________________________________________________

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

    最大行 = 终点

    Do

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

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

                临时储存 = arr(i - 1)

                arr(i - 1) = arr(i)

                arr(i) = 临时储存

            End If

        Next i

    最大行 = 最大行 - 1

    Loop While 最大行 > 0

    一维数组冒泡升序 = arr

End Function

______________________________________________________________________________________________________

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

    最大行 = 终点

    Do

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

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

                临时储存 = arr(i - 1)

                arr(i - 1) = arr(i)

                arr(i) = 临时储存

            End If

        Next i

    最大行 = 最大行 - 1

    Loop While 最大行 > 0

    一维数组冒泡降序 = arr

End Function

______________________________________________________________________________________________________

一维数组排序函数是只有3个参数,我们输入一个数组,数组需要排序部分的起始点,终止点三个参数就可以实现一维数组的排序.

函数的参数:

arr:数组

起始点,终止点:数组需要排序部分的起始点和终止点

调试代码如下:

Sub 一维数组测试()

    arr = Array(11, 20, 15, 13, 14, 16, 1)

    brr = 一维数组冒泡升序(arr, 2, 5)’此处打断点

End Sub

我们可以看到一维数组在排序前的状态

再看看排序以后的状态:

我们可以清楚的看到这一段代码实现了两个功能,第一个是排序,第二个是局部改动.局部改动有什么用呢?到了后面自然会知道.

在单元格只有一列的情况下我们可以通过循环将数据填入一维数组在通过函数排序.输出到原来的位置,这一步没有任何问题的,但是如果多列会怎么样呢?

这个时候我们回想下在excel表中的排序,excel会提示是否扩招区域排序,何谓扩展区域排序?就是指需要排序数据的那一行整行都要跟着这个数据去变换位置数据排第几,原来的行就排第几.不扩展区域就是值指的单纯的单列排序,其他数据不动位置.通常情况下我们都是需要扩展排序区域的.这一步倒不难实现,但麻烦不止于此.多列排序中次列排序是指主列排好序以后,主列相同项目的部分区域,再在次列中内部再排序调换位置.而不是主列排好以后次列再从头到尾排一遍,这样会导致主列排好的顺序被再次打乱.

我们不妨先解决第一个问题:单列扩区区域排序.

一维数组的排序函数我们已经有了,二维数组单列排序怎么处理呢?二维数组排序通常是需要扩展区域排序的.这又如何处理呢?

很简单,字典,字典的Keys是一个一维数组,我们将Keys作为参数传递到排序函数中就可以实现排序,同时录入数据到字典的Keys记录其行号到字典的Items,字典在填装的时候,会将相同的项目整合在一起,Items里面会覆盖掉原来的行号,我么利用累计录入的方式可以记录下所有的行号.由于字典录入的时候是一个方向循环录入的,所以相同项目整合的时候是按照一个方向整合的,相同的项目会被认作为同一个Key,新的行号会按先来后到的顺序编入到其相对应的Item中.如此一来就避免了部分排序不稳定的缺点,再将字典的Keys排好序以后,利用函数有一个计算结果的特性我们取出这个排好序的数组,再循环排好序的数组,利用字典(key)=item就可以按排序顺序取出行号,输出即可得到扩招区域的排序.

看图:

这是一个原数组

现在我们把他装入到字典里面去,看看会得到什么

 

我们以排序列的值为key,行号为item,得到一个行号字典,字典的keys是一个数组包含了所有不重复的key,利用字典我们可以取出item,行号都有了还担心取不出数据吗?

下图是结果!

字典的特点,我们是通过循环录入key的,这样一来,相同的key就会按照一个方向录入对应items.再排序keys的时候就不存在相同元素会变化相对位置的情况了(也就是不存在不稳定的情况了),我们可以理解为相同的值被按顺序打包在一起保护起来,最后按顺序取出来.、

字典函数如下:

__________________________________________________________________

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

Dim dic

    Set dic = CreateObject("Scripting.Dictionary")

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

        key = Abs(All(i, 值列))

        If dic.Exists(key) = False Then

            dic(key) = i

        Else

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

        End If

    Next

    If 功能 = 0 Then

        行号记录字典 = dic.keys

    ElseIf 功能 = 1 Then

        行号记录字典 = dic.Items

    Else

        Set 行号记录字典 = dic

    End If

End Function

字典的参数:

第一参数:ALL是指的排序的整个区域,是一个二维数组.

第二参数:值列是指的二维数组需要排序的列.

第三第四参数:数组索引起点, 数组索引终点是指的需要排序的起始行和终止行.

第五参数:可选,为函数输出结果,这里不用枚举,新手不整那么高端

此时一定会有人说:你直接从头到尾录入字典不就完事儿了吗?多整个第三第四俩参数干嘛呢?难道二维数组排序还需要局部排序吗?对!需要,别急后面有妙用.

我们看一下数据:

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

字典测试代码.

Sub 字典测试()

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

    brr = 行号记录字典(arr, 4, 3, 52)

End Sub

字典的keys

 

字典的Items

 

监视窗口中我们看到了字典中将相同项目的行号整合了起来,且每一个行号都是按顺序录入的.为了方便取出,我们在录入新行号时我们加入了分隔符,方便取出行号.后期我们会利用这一点拆解出行号.

接下来我们需要调整二维数组的各个行了,这里我们的代码设计上要求能自由升序降序,所以我将一维数组排序的模块做了两个一个是升序一个是降序.在调用不同的模块时我们是利用”+””-”号来控制的.这一步可以在” f 值列 < 0 Then”这一句看得到,这段代码过于简单枯燥这里就不详细解读了只大概说两点,第一点我们循环将排好序的keys数组里的key挨个儿取出(字典并没变化,只是将复制的keys排序,换句话说就是arr = dic.keys ,arr排序),然后再利用字典的特点dic(key)=item取出行号,拆解,循环,将原来的数组的一整行一整行的存入新的同等大小的数组,虽然增加了空间复杂度,但是一VBA代码,真的用不着太专业.现在我们直接去后面

单列扩展区域的排序函数函数如下

__________________________________________________________________

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

二维数组在单列扩展区域实现排序后怎么实现多列

前面做过实验,我们已经实现了数组内局部排序,为什么需要这个功能呢?很简单,因为次列排序刚好其实就是局部排序,但是我们又怎么知道相同项是那几行呢?很简单,字典啊,我们观察一下字典的Items,不难发现,相同项的行其实是按顺序来排好的,这么一来我们在排好序以后,再录入字典一次就可以得到一个相同项的区域范围了.现在的问题不在于此

下图是原数组录入后的结果

 

下图是主列排好序以后再次录入字典的结果

 

 

brr数组就是字典的items.字典模块中其实是有一个可选参数的,通过控制可选参数其实是可以控制模块的输出的.

 

观察重新填装的字典的items,行号记录.我们不难发现其实行号都是按顺序记录的,这样一来每一个item的开头就是主列相同元素部分的起始行,结尾是终止行.如果将次参数传递到前面的几个模块,就可以实现次列的排序了.那怎么传递参数呢?很简单,递归.

什么是递归?一句话:

函数:我自己调用我自己

这就是递归运行的流程图,如果递归过程中不设置跳出语句,那么这货会一直就这么下去直到栈溢出(就是电脑玩不下去了).注意看黄色的语句,如果一直执行下去,黄色的语句是不可能被执行的但是如果有跳出函数的设定,一旦跳出函数.就会倒回来一层一层的执行黄色语句.这里要提醒一点:这东西的好处是处理问题简单粗暴,能将相同的动作一层一层的执行完,如果被调用的函数(他自己)具备参数化的设计,那么将每一层执行后产生的新数据传入到下一层的函数调用中就可以实现某些功能,比如我们这个多列排序的函数

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

每一层数组都会传递下去,没有变化.值列串是需要排序的列号字符串没有变化,变化的部分呢是区域和递推,递推这个参数其实是用来取列号的,没到下一层就递推一下.而区域的变化其实是利用字典重复值记录行号这个动作来取得.详细可以观察一下代码.

代码的解读

一开始我们拆分值列串,然后做限制:split拆分出来的是一个一维数组,看调试

我们可以观察本地窗口:

“arr_值组”是一个数组,我们能通过递推这个参数取出需要排序的列的列号.所以第一层递推不需要赋值,因为默认他是0而每一层递归,他自己都会递推一个,取下一列

S是”arr_值组”的上标,通过s就可以知道有几列需要排序,知道了这一点就可以控制递归的层数.这样就不会无线递归下去,所以我们做了限制” If 递推 > s Then Exit Function”,但是还有一个限制是” If 递推 > 5 Then Exit Function”目的是害怕递归太多栈溢出.

然后调用单列冒泡排序模块实现二维数组扩展区域单列排序

完成上述上述后录入字典,改变arr,第一次调用自己,递归开始

如此反复就可以完成排序.

测试代码如下(含使用方法)

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)

Arr指的是需要排序的数组

值列串是该数组需要排序的列串在一起的字符串

如下红框部分

 

通过逗号将各个列号连接在一起用引号包起来,其中正负号的作用是控制升序降序的,

起点和终点是该数组需要排序部分的起始行和终止行,比如上述数据中第一行是表标题,第二行是表头,从第三行开始,最后一行结束

递推是可选参数,不需要填入,在模块内会自动填入

使用方法详见上面.

 

 

 我不市专业的码农,很多东西都是“土方法”,这里只提供一个参考

 

 

  • 0
    点赞
  • 3
    收藏
    觉得还不错? 一键收藏
  • 0
    评论

“相关推荐”对你有帮助么?

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值