ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

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

[原创] 二维数组排序,可与range.sort媲美

  [复制链接]

TA的精华主题

TA的得分主题

发表于 2012-2-2 11:33 | 显示全部楼层 |阅读模式
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
本帖已被收录到知识树中,索引项:排序
本帖最后由 Zamyi 于 2012-2-6 09:50 编辑

Sort.rar (17 KB, 下载次数: 362) 二维数组排序,只有泓写过一个:http://club.excelhome.net/forum.php?mod=viewthread&tid=457747,但速度明显不行。写了一个,在07版下测试,速度相当,但只支持一个关键字。代码暂不公开。
源码: 排序(VBA).rar (15.59 KB, 下载次数: 802)
2012年2月6日更新
本次更新对原来进行优化,增加多关键字排序。07版下以正数或浮点数据排序,50000*10数组,KEY三个,结果将近快一倍,文本的稍慢。range.sort只支持三个关键字,二维数组不限制。

多Key二维数组排序.rar

18.09 KB, 下载次数: 1884

点评

知识树内容索引:一楼最后的文件里面有源码,20楼法师的帖子  发表于 2013-9-24 17:52

评分

4

查看全部评分

TA的精华主题

TA的得分主题

发表于 2012-2-2 11:51 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
本帖最后由 win2009 于 2012-2-2 11:53 编辑

找不到工程或库,哈哈
  1. Dim Z  As New Zamyi_Sort
复制代码

TA的精华主题

TA的得分主题

 楼主| 发表于 2012-2-2 14:07 | 显示全部楼层
win2009 发表于 2012-2-2 11:51
找不到工程或库,哈哈

工具——引用——浏览,选择Zamyi_Sort.dll。

TA的精华主题

TA的得分主题

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

http://club.excelhome.net/thread-766196-1-1.html

我在这个帖子中,也有过尝试。

最后完成的对于VBA内存数组对象进行排序的代码如下:

需要排序的二维数组x(),数组总列数m,指定排序第n列,排序方式s(s=0时,Z-A排序,s=1时A-Z排序),
以及是否有标题行h,这样一共是4个参数
  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
复制代码

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2012-2-2 22:49 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
排序过程代码中,首先对第n列中,值为空白的那些行,一律排到最后(模仿Excel排序规则,空格行到最后。)

接着,依次搜寻比较最大值(s参数=0时,Z-A排序),或最小值(s参数=1时,A-Z排序)
并记录、更新得到所有符合最大值条件的行的序号……

这个处理方式,似乎是我独自创立的吧。可以高效处理同类元素。

……

最后,在按此做法循环遍历。

TA的精华主题

TA的得分主题

发表于 2012-2-2 23:02 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
二维数组的列数m,可以按照数组第二维下标最大值m=ubound(x,2)来直接得到,

但是,或许有时候直接指定也是一种需要,
因其作用,是可以直接在VBA过程中,对于对象数组指定参与排序的列数范围……

TA的精华主题

TA的得分主题

发表于 2012-2-2 23:03 | 显示全部楼层
支持,谢谢分享,希望最后可以公开源码,让新手学习一下.

TA的精华主题

TA的得分主题

 楼主| 发表于 2012-2-3 09:02 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
香川群子 发表于 2012-2-2 22:41
http://club.excelhome.net/thread-766196-1-1.html

我在这个帖子中,也有过尝试。

哦,原来香群子也写过。不过,速度比泓还差,比我的慢200倍。

TA的精华主题

TA的得分主题

发表于 2012-2-3 10:17 | 显示全部楼层
Zamyi 发表于 2012-2-3 09:02
哦,原来香群子也写过。不过,速度比泓还差,比我的慢200倍。

嗯.

当时写这个VBA内存二维数组排序代码时,行数100行以内……所以后来就优化啥都没有做


…………

如果排序中使用希尔排序代码,大概速度可以提高10倍。


TA的精华主题

TA的得分主题

发表于 2012-2-3 10:23 | 显示全部楼层
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

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

GMT+8, 2024-3-29 21:18 , Processed in 0.053042 second(s), 12 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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