ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 6823|回复: 16

怎么用二位数组实现这个分组排序

[复制链接]

TA的精华主题

TA的得分主题

发表于 2011-9-20 12:45 | 显示全部楼层 |阅读模式
本帖已被收录到知识树中,索引项:排序
本帖最后由 陈酿 于 2011-9-20 12:49 编辑

附件是针对于后三列排序(sheet1 排序前,sheet2排序后),现在需要根据数据的倒数n列,n可能是4以上的数值,怎么用二维数组来实现呢

问题.rar (1.64 KB, 下载次数: 55)

TA的精华主题

TA的得分主题

 楼主| 发表于 2011-9-20 12:50 | 显示全部楼层
自己顶一下

TA的精华主题

TA的得分主题

发表于 2011-9-20 13:04 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2011-9-20 13:19 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
jiangxj 发表于 2011-9-20 13:04
加辅助列:j1=i1 & h1 & g1 & f1 下拉
按j 列排序

要求不让用辅助列

TA的精华主题

TA的得分主题

发表于 2011-9-20 13:54 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
其实也不太难。

Excel排序的原则是,最重要的排序要放在最后一个操作。

如果你要按照倒数第1列、倒数第2列、倒数第3列、……倒数第n列的顺序来对数据排序的话,
实际操作时需要反过来,即:
先排倒数第n列,然后倒数n-1列……倒数第3列、倒数第2列、倒数第1列。结束。


代码如下:
  1. Sub px1()
  2.     m = [a1].End(2).Column '获取排序范围总列数m
  3.     n = InputBox("Please input sort columns number:" & vbCr & "less then  <= " & m, "sort", 4)
  4.     If n = "" Then Exit Sub Else n = Val(n) ‘对话窗输入要从倒数第n列开始排序。取消则退出宏。
  5.     If n=0 or n > m Then '如果输入列数n=0,或n大于实际列数m,则恢复默认第1列排序后退出宏。
  6.         MsgBox "Will be Restore (Sort by No.1)" '出现提示对话框
  7.         [a1].CurrentRegion.Sort Key1:=[a1], Header:=xlYes '恢复按第1列排序。
  8.         Exit Sub '退出宏
  9.     End If
  10.     For i = 1 To n '按倒数第n列开始排序直至倒数第1列。
  11.         [a1].CurrentRegion.Sort Key1:=[a1].Offset(0, m - n + i - 1), Header:=xlYes
  12.     Next
  13. End Sub
复制代码

Sort.zip

8.28 KB, 下载次数: 118

TA的精华主题

TA的得分主题

发表于 2011-9-20 13:57 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
本帖最后由 香川群子 于 2011-9-20 17:00 编辑

但是,如果要在内存二维数组内实现排序操作,会很麻烦的。

VBA代码排序,速度远没有Excel表内的Sort操作快。(这是我当初的想法,后来证明不一定。)

…………
呵呵,经过思考,完成了数组内排序的代码:

  1. Sub szpx(x(), m, n, k, h)
  2. For i = LBound(x) + h To UBound(x)
  3. ts = x(i, n)
  4. ps = "," & i

  5. For j = i + 1 To UBound(x)
  6. If ts > x(j, n) Then
  7. ts = x(j, n)
  8. ps = "," & j
  9. ElseIf ts = x(j, n) Then
  10. ps = ps & "," & j
  11. End If
  12. Next

  13. t = Split(ps, ",")
  14. c = UBound(t)

  15. y = x
  16. For j = 1 To c
  17. For l = 1 To m
  18. y(i + j - 1, l) = x(t(j), l)
  19. Next
  20. x(t(j), n) = ""
  21. Next

  22. k = i + c
  23. For j = i To UBound(x)
  24. If x(j, n) = "" Then
  25. If c = 1 Then Exit For Else c = c - 1
  26. Else
  27. For l = 1 To m
  28. y(k, l) = x(j, l)
  29. Next
  30. k = k + 1
  31. End If
  32. Next

  33. x = y

  34. Next
  35. End Sub
复制代码

下面是执行代码:
和Excel排序代码几乎相同,不解释了。
  1. Sub px2()
  2.     m = [a1].End(2).Column
  3.     n = InputBox("Please input sort columns number:" & vbCr & "less then  <= " & m, "sort", 4)
  4.     If n = "" Then Exit Sub Else n = Val(n)
  5.     tm = Timer
  6.    
  7.     ReDim arr(1, 1)
  8.     x = [a1].CurrentRegion
  9.     arr = x
  10.    
  11.     If n = 0 Or n > m Then
  12.         MsgBox "Will be Restore (Sort by No.1)"
  13.         tm = Timer
  14. '        [a1].CurrentRegion.Sort Key1:=[a1], Header:=xlYes
  15.         szpx arr, m, 1, 0, 1
  16.         [a1].CurrentRegion = arr
  17.         MsgBox Format(Timer - tm, "0.000")
  18.         Exit Sub
  19.     End If
  20.    
  21.     For i = 1 To n
  22.         szpx arr, m, m - n + i, 0, 1
  23. '        [a1].CurrentRegion = arr
  24.     Next
  25.     [a1].CurrentRegion = arr
  26.    
  27.     MsgBox Format(Timer - tm, "0.000")
  28. End Sub
复制代码

试验结果,居然数组比Excel排序更快一些。不可思议。

最后是附件:

Sort2.zip (12 KB, 下载次数: 161)



TA的精华主题

TA的得分主题

发表于 2011-9-22 16:29 | 显示全部楼层
增加了Z-A排序的内容。

以及,数组内排序,增加了空白单元格自动排最后。

首先,是Excel自带排序功能的录制代码:
  1. Sub px1()
  2.     m = [a1].End(2).Column
  3.     n = InputBox("Please input sort columns number:" & vbCr & "less then  <= " & m, "sort", 0)
  4.     If n = "" Then Exit Sub Else n = Val(n)
  5.     s = InputBox("Please select s=0 for Ascending or s=1 for Descending Order", "sort", 0)
  6.     tm = Timer
  7.    
  8.     If n = 0 Or n > m Then
  9.         MsgBox "Will be Restore (Sort by No.1)"
  10.         tm = Timer
  11.         If s = 0 Then
  12.             [a1].CurrentRegion.Sort Key1:=[a1], Order1:=xlAscending, Header:=xlYes
  13.         ElseIf s = 1 Then
  14.             [a1].CurrentRegion.Sort Key1:=[a1], Order1:=xlDescending, Header:=xlYes
  15.         End If
  16.         MsgBox Format(Timer - tm, "0.000")
  17.         Exit Sub
  18.     End If
  19.     If s = 0 Then
  20.         For i = 1 To n
  21.             [a1].CurrentRegion.Sort Key1:=[a1].Offset(0, m - n + i - 1), Order1:=xlAscending, Header:=xlYes
  22.         Next
  23.     ElseIf s = 1 Then
  24.         For i = 1 To n
  25.             [a1].CurrentRegion.Sort Key1:=[a1].Offset(0, m - n + i - 1), Order1:=xlDescending, Header:=xlYes
  26.         Next
  27.     End If
  28.    
  29.     MsgBox Format(Timer - tm, "0.000")
  30. End Sub
复制代码
下面是数组操作代码:
  1. Sub px2()
  2.     m = [a1].End(2).Column
  3.     n = InputBox("Please input sort columns number:" & vbCr & "less then  <= " & m, "sort", 0)
  4.     If n = "" Then Exit Sub Else n = Val(n)
  5.     s = InputBox("Please select s=0 for Ascending or s=1 for Descending Order", "sort", 0)
  6.     tm = Timer
  7.    
  8.     ReDim arr(1, 1)
  9.     x = [a1].CurrentRegion
  10.     arr = x
  11.    
  12.     If n = 0 Or n > m Then
  13.         MsgBox "Will be Restore (Sort by No.1)"
  14.         tm = Timer
  15. '        [a1].CurrentRegion.Sort Key1:=[a1], Header:=xlYes
  16.         szpx arr, m, 1, s, 1
  17.         [a1].CurrentRegion = arr
  18.         MsgBox Format(Timer - tm, "0.000")
  19.         Exit Sub
  20.     End If
  21.    
  22.     For i = 1 To n
  23.         szpx arr, m, m - n + i, s, 1
  24. '        [a1].CurrentRegion = arr
  25.     Next
  26.     [a1].CurrentRegion = arr
  27.    
  28.     MsgBox Format(Timer - tm, "0.000")
  29. End Sub
复制代码
最后,是数组内排序的过程代码:
  1. Sub szpx(x(), m, n, s, h)
  2.     For i = LBound(x) + h To UBound(x)
  3.         If x(i, n) = "" Then p = p & "," & i
  4.     Next
  5.     If p <> "" Then
  6.         y = x
  7.         k = h
  8.         For j = LBound(x) + h To UBound(x)
  9.             If x(j, n) <> "" Then
  10.                 k = k + 1
  11.                 For l = 1 To m
  12.                     y(k, l) = x(j, l)
  13.                 Next
  14.             End If
  15.         Next
  16.         
  17.         q = Split(p, ",")
  18.         b = UBound(q)
  19.         For j = 1 To b
  20.             k = k + 1
  21.             For l = 1 To m
  22.                 y(k, l) = x(q(j), l)
  23.             Next
  24.         Next
  25.         x = y
  26.     End If
  27.    
  28.     For i = LBound(x) + h To UBound(x) - b
  29.         t = x(i, n)
  30.         p = "," & i
  31.         For j = i + 1 To UBound(x) - b
  32.             If s = 0 And t > x(j, n) Then
  33.                 t = x(j, n)
  34.                 p = "," & j
  35.             ElseIf s = 1 And t < x(j, n) Then
  36.                 t = x(j, n)
  37.                 p = "," & j
  38.             ElseIf t = x(j, n) Then
  39.                 p = p & "," & j
  40.             End If
  41.         Next
  42.         
  43.         q = Split(p, ",")
  44.         c = UBound(q)
  45.         
  46.         y = x
  47.         For j = 1 To c
  48.             For l = 1 To m
  49.                 y(i + j - 1, l) = x(q(j), l)
  50.             Next
  51.             x(q(j), n) = ""
  52.         Next
  53.         
  54.         k = i + c
  55.         For j = i To UBound(x) - b
  56.             If x(j, n) = "" Then
  57.                 If c = 1 Then Exit For Else c = c - 1
  58.             Else
  59.                 For l = 1 To m
  60.                     y(k, l) = x(j, l)
  61.                 Next
  62.                 k = k + 1
  63.             End If
  64.         Next
  65.         
  66.         x = y
  67.         
  68.     Next
  69. End Sub

复制代码
最后,发现数组内排序操作,当数据量稍多就很慢了。

Sort3.zip

14.22 KB, 下载次数: 144

TA的精华主题

TA的得分主题

发表于 2011-9-22 16:41 | 显示全部楼层
为啥不用sql来排序。很省力
  1. Sub Macro1()
  2.     Dim cnn As Object, SQL$
  3.     Set cnn = CreateObject("ADODB.Connection")
  4.     cnn.Open "Provider = Microsoft.Jet.Oledb.4.0;Extended Properties =Excel 8.0;Data Source =" & ThisWorkbook.FullName
  5.     SQL = "Select * from [Sheet1$" & Sheet1.[a1].CurrentRegion.Address(0, 0) & "] order by h,g,f,e,d,c,b,a"
  6.     With Sheet2
  7.         .UsedRange.Offset(1).ClearContents
  8.         .[a2].CopyFromRecordset cnn.Execute(SQL)
  9.     End With
  10.     cnn.Close
  11.     Set cnn = Nothing
  12. End Sub
复制代码

TA的精华主题

TA的得分主题

发表于 2011-9-22 17:01 | 显示全部楼层
sql 方法不错,也很快。但是和Excel自带排序不同,空格会排在最前面。



TA的精华主题

TA的得分主题

 楼主| 发表于 2011-9-27 17:03 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
eujgnaw 发表于 2011-9-22 16:41
为啥不用sql来排序。很省力

不让用啊 sql的话很多都方便了
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-3-29 20:16 , Processed in 0.056353 second(s), 10 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表