ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

EH搜索     
EH云课堂-专业的职场技能充电站 Excel转在线管理系统,怎么做看这里 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! Excel 2016函数公式学习大典 高效办公必会的Office实战技巧 免费下载Excel行业应用视频
300集Office 2010微视频教程 Tableau-数据可视化工具 精品推荐-800套精选PPT模板,点击获取 ExcelHome出品 - VBA代码宝免费下载
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 Excel VBA经典代码实践指南
查看: 2430|回复: 11

[求助] 怎么用VBA获取excell中的指定规则来排序

[复制链接]

TA的精华主题

TA的得分主题

发表于 2013-10-28 20:19 | 显示全部楼层 |阅读模式
本帖已被收录到知识树中,索引项:排序和排名
如图,按照 Sheet2里的规则,对Sheet1里的内容进行排序。请高手帮帮忙{:soso_e154:}
1.jpg
2.jpg


附件:
指定规则排序.rar (7.24 KB, 下载次数: 54)

TA的精华主题

TA的得分主题

发表于 2013-10-28 21:18 | 显示全部楼层
本帖最后由 zhaogang1960 于 2013-10-28 21:21 编辑

按照Sheet2中B列循序排序,如果是请测试:
  1. Sub 宏1()
  2.     Dim arr
  3.     arr = Sheets("Sheet2").Range("B1:B" & Sheets("Sheet2").Range("B" & Rows.Count).End(xlUp).Row)
  4.     Application.AddCustomList ListArray:=arr
  5.     Range("A1").CurrentRegion.Sort Key1:=Range("A2"), Header:=xlYes, _
  6.                 OrderCustom:=Application.CustomListCount + 1
  7.     Application.DeleteCustomList ListNum:=Application.CustomListCount
  8. End Sub
复制代码

TA的精华主题

TA的得分主题

发表于 2013-10-28 21:21 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2013-10-28 22:03 | 显示全部楼层
  1. Sub Macro1()
  2. Dim arr, brr, crr, d As Object, i&, j&, k&, s&, y&
  3. Set d = CreateObject("scripting.dictionary")
  4. arr = Sheet1.Range("a1").CurrentRegion
  5. crr = arr
  6. brr = Sheet2.Range("a1").CurrentRegion
  7. y = UBound(brr)
  8. For i = 2 To UBound(arr)
  9.     d(arr(i, 1)) = d(arr(i, 1)) & "," & i
  10. Next
  11. For i = 1 To UBound(brr)
  12.     x = Split(Mid(d(brr(i, 2)), 2), ",")
  13.     s = 0
  14.     For j = 0 To UBound(x)
  15.         s = j * y + i + 1
  16.         For k = 1 To UBound(arr, 2)
  17.             crr(s, k) = arr(x(j), k)
  18.         Next
  19.     Next
  20. Next
  21. Range("f1").Resize(UBound(crr), UBound(crr, 2)) = crr
  22. End Sub
复制代码

TA的精华主题

TA的得分主题

发表于 2013-10-28 22:05 | 显示全部楼层
………………

指定规则排序.zip

10.81 KB, 下载次数: 28

TA的精华主题

TA的得分主题

 楼主| 发表于 2013-10-29 08:37 | 显示全部楼层
zhaogang1960 发表于 2013-10-28 21:18
按照Sheet2中B列循序排序,如果是请测试:

受教了。测试了下,在Sheet2.B列里增加内容也可以自动排序,很强大,非常感谢。

TA的精华主题

TA的得分主题

 楼主| 发表于 2013-10-29 08:38 | 显示全部楼层
dsmch 发表于 2013-10-28 22:03

看了下效果,最后结果是按学期来排序了,不是我要的效果哦。不过还是非常感觉您的帮忙。

TA的精华主题

TA的得分主题

发表于 2013-10-29 11:49 | 显示全部楼层
jnear 发表于 2013-10-29 08:38
看了下效果,最后结果是按学期来排序了,不是我要的效果哦。不过还是非常感觉您的帮忙。
  1. Sub Macro1()
  2. Dim arr, brr, crr, d As Object, i&, j&, k&, s&
  3. Set d = CreateObject("scripting.dictionary")
  4. arr = Sheet1.Range("a1").CurrentRegion
  5. crr = arr
  6. brr = Sheet2.Range("a1").CurrentRegion
  7. For i = 2 To UBound(arr)
  8.     d(arr(i, 1)) = d(arr(i, 1)) & "," & i
  9. Next
  10. s = 1
  11. For i = 1 To UBound(brr)
  12.     x = Split(Mid(d(brr(i, 2)), 2), ",")
  13.     For j = 0 To UBound(x)
  14.         s = s + 1
  15.         For k = 1 To UBound(arr, 2)
  16.             crr(s, k) = arr(x(j), k)
  17.         Next
  18.     Next
  19. Next
  20. Range("f1").Resize(UBound(crr), UBound(crr, 2)) = crr
  21. End Sub
复制代码

TA的精华主题

TA的得分主题

发表于 2013-10-29 11:51 | 显示全部楼层
……………………

指定规则排序.zip

10.71 KB, 下载次数: 29

TA的精华主题

TA的得分主题

发表于 2014-9-29 14:51 | 显示全部楼层
zhaogang1960 发表于 2013-10-28 21:18
按照Sheet2中B列循序排序,如果是请测试:

请教:按C列数字大小排呢?谢谢!
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关注官方微信,高效办公专列,每天发车

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

GMT+8, 2019-8-20 08:42 , Processed in 0.097437 second(s), 14 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2020 Wooffice Inc.

   

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

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

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