ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

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

[分享] VBA中实现数组排序的简单方法

[复制链接]

TA的精华主题

TA的得分主题

发表于 2018-7-8 23:06 | 显示全部楼层 |阅读模式
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
今天因为在做一个数组内部排序的小函数,找了半天,有些运算错误,有些复杂,自己参照网上搜索到的,调整了一下,觉得比较简单,就拿来分享,希望能有帮助
新手作品,高手么笑哈

  1. Public Sub subPaiXu()
  2. Dim Arr As Variant, Arr1 As Variant, i As Integer
  3. Arr = Array(10, 6, 3, 47, 15, 6, 4, 57, 16, 7)    '设这个数组,是为了验证重复数如何处理
  4. Arr1 = funPaiXu(Arr)
  5. i = 1    '设断点观察最终结果
  6. End Sub
复制代码
  1. Public Function funPaiXu(Arr As Variant)
  2. Dim MaxV As Variant, i As Integer, j As Integer, a As Integer, b As Integer
  3. a = UBound(Arr) - 1
  4. b = a
  5. For i = a To 0 Step -1
  6.     MaxV = Arr(i)    '取最后一个数
  7.     For j = 0 To b    '通过循环,将最小数放在本次循环内数组最后
  8.         If Arr(j) < MaxV Then    '本函数结果是由大到小排序,如果由小到大,改“<”为“>”
  9.             MaxV = Arr(j)
  10.             Arr(j) = Arr(i)
  11.             Arr(i) = MaxV
  12.         End If
  13.     Next j
  14.     b = b - 1    '下次比较截止到数组倒数第二个元素,依次递减
  15. Next i
  16. funPaiXu = Arr
  17. End Function
复制代码


TA的精华主题

TA的得分主题

发表于 2018-7-9 04:06 | 显示全部楼层
是啊,网上有很多的排序方法,有些真的看的云里雾里,没有扎实的数学功底和编程能力,想看懂都很困难。
本人一般尽量使用表格自身的排序功能,效率是很高的。

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-7-9 11:37 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
通过这段时间玩VBA,本人养成了一个习惯:喜欢把表格里的数据提取到VBA程序里,然后一直在里面操作,最终结果才往表格里输入,这样,难度有所增加,但思路却非常清晰。
这样的操作方法,就少不得要大量用到数组的操作。因此,我个人认为,熟练掌握数组的操作,对提升VBA的运用,很有帮助。尤其是Excel作为电子表格主要处理数值,更应如此

TA的精华主题

TA的得分主题

发表于 2018-7-9 11:48 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
数组内容为文本,如何排序 ?

TA的精华主题

TA的得分主题

发表于 2018-7-9 11:49 来自手机 | 显示全部楼层
ygsh168 发表于 2018-7-9 11:37
通过这段时间玩VBA,本人养成了一个习惯:喜欢把表格里的数据提取到VBA程序里,然后一直在里面操作,最终结 ...


数组的经典排序算法很多的!简单的是:直接调用库函数对数组进行排序而不必去考虑库函数内部的排序算法。

TA的精华主题

TA的得分主题

发表于 2018-7-9 11:51 来自手机 | 显示全部楼层
zopey 发表于 2018-7-9 11:48
数组内容为文本,如何排序 ?

你上个附件,我有空给你写一个。

TA的精华主题

TA的得分主题

发表于 2018-7-9 12:30 | 显示全部楼层
二维数组 按照 元素内部首次出现的数字 进行升序!详见图片中右边效果!
123.jpg

TA的精华主题

TA的得分主题

发表于 2018-7-9 12:46 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
zopey 发表于 2018-7-9 11:48
数组内容为文本,如何排序 ?

二维数组 按照 元素内部首次出现的“文本” 进行升序!详见图片中右边,是这个效果吗?
123.jpg

TA的精华主题

TA的得分主题

发表于 2018-7-9 14:32 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
duquancai 发表于 2018-7-9 12:46
二维数组 按照 元素内部首次出现的“文本” 进行升序!详见图片中右边,是这个效果吗?

模拟 单元格排序的结果就好。

TA的精华主题

TA的得分主题

发表于 2018-7-9 15:13 | 显示全部楼层
zopey 发表于 2018-7-9 14:32
模拟 单元格排序的结果就好。
  1. Sub main()
  2.     Dim arr, Callback$
  3.     arr = [a2:c100] '假设数据区域,按照第二列的"文本"进行降序!
  4.     Callback = "function(x,y){return y[1].localeCompare(x[1])}"
  5.     Call msort(arr, Callback, 2)
  6.     [a2:c100] = arr
  7. End Sub
  8. Sub msort(ByRef a, ByVal q As String, ByVal k As Integer)
  9. '    a为源数组;q为回调函数,k为1是一维数组为2是二维数组
  10.     Dim js As Object, i&
  11.     Set js = CreateObject("MSScriptControl.ScriptControl")
  12.     js.Language = "JavaScript"
  13.     If k = 2 Then
  14.         Dim l1&, l2&, u1&, u2&, s$, sr$, j&
  15.         l1 = LBound(a): l2 = LBound(a, 2): u1 = UBound(a): u2 = UBound(a, 2)
  16.         For i = l1 To u1
  17.             For j = l2 To u2
  18.                 If j = l2 Then s = "'" & a(i, j) & "'" Else: s = s & "," & "'" & a(i, j) & "'"
  19.             Next
  20.             sr = sr & "," & "[" & s & "]": s = Empty
  21.         Next
  22.         sr = "[" & Mid(sr, 2) & "]"
  23.         js.AddCode "a=" & sr & ";a.sort(" & q & ")"
  24.         For i = l1 To u1
  25.             For j = l2 To u2
  26.                 a(i, j) = js.eval("a[" & i - l1 & "][" & j - l2 & "]")
  27.             Next
  28.         Next
  29.     ElseIf k = 1 Then
  30.         Dim l&, u&, s1$
  31.         l = LBound(a): u = UBound(a)
  32.         For i = l To u
  33.             If i = l Then s1 = "'" & a(i) & "'" Else: s1 = s1 & "," & "'" & a(i) & "'"
  34.         Next
  35.         s1 = "[" & s1 & "]"
  36.         js.AddCode "a=" & s1 & ";a.sort(" & q & ")"
  37.         For i = l To u
  38.             a(i) = js.eval("a[" & i - l & "]")
  39.         Next
  40.     End If
  41. End Sub
复制代码

评分

1

查看全部评分

您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

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

GMT+8, 2024-3-28 18:27 , Processed in 0.059169 second(s), 12 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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