Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 2966|回复: 7

[已解决]VBA排序问题

[复制链接]
发表于 2015-2-27 20:16 | 显示全部楼层 |阅读模式
本帖最后由 龙送农 于 2015-2-27 23:34 编辑

VBA排序:
1、先将2月份至12月份各项数据按B列C列D列进行升序排列;
2、再将1月份各项数据同样按B列C列D列进行升序排列放在12月份后面。
最佳答案
2015-2-27 21:14
  1. Sub Macro1()
  2. Dim rng As Range, n&, s&
  3. Range("a4").CurrentRegion.Sort Key1:=[b5], Key2:=[c5], Key3:=[d5], Header:=xlGuess
  4. n = Range("b65536").End(xlUp).Row + 1
  5. Set rng = [b:b].Find(1, lookat:=xlWhole, searchdirection:=xlPrevious)
  6. If Not rng Is Nothing Then
  7.     s = rng.Row
  8.     Range([a5], Cells(s, "o")).Cut (Cells(n, 1))
  9.     Range([a5], Cells(s, "o")).Delete Shift:=xlUp
  10. End If
  11. End Sub
复制代码

VBA排序问题.zip

124.57 KB, 下载次数: 9

发表于 2015-2-27 21:14 | 显示全部楼层    本楼为最佳答案   
  1. Sub Macro1()
  2. Dim rng As Range, n&, s&
  3. Range("a4").CurrentRegion.Sort Key1:=[b5], Key2:=[c5], Key3:=[d5], Header:=xlGuess
  4. n = Range("b65536").End(xlUp).Row + 1
  5. Set rng = [b:b].Find(1, lookat:=xlWhole, searchdirection:=xlPrevious)
  6. If Not rng Is Nothing Then
  7.     s = rng.Row
  8.     Range([a5], Cells(s, "o")).Cut (Cells(n, 1))
  9.     Range([a5], Cells(s, "o")).Delete Shift:=xlUp
  10. End If
  11. End Sub
复制代码
回复

使用道具 举报

发表于 2015-2-27 21:15 | 显示全部楼层
完全没理解楼主要的效果,语文太差了
回复

使用道具 举报

 楼主| 发表于 2015-2-27 22:10 | 显示全部楼层
dsmch 发表于 2015-2-27 21:14

老师:您写的代码就是我要的效果,因我的表有合并单元格,怎么解决?

VBA排序问题1.zip

127.75 KB, 下载次数: 12

回复

使用道具 举报

发表于 2015-2-28 05:29 | 显示全部楼层
  1. Sub Macro1()
  2. Dim rng As Range, n&, s&
  3. n = Range("b65536").End(xlUp).Row
  4. Range([b4], Cells(n, "s")).Sort Key1:=[b5], Key2:=[c5], Key3:=[d5], Header:=xlGuess
  5. Set rng = [b:b].Find(1, lookat:=xlWhole, searchdirection:=xlPrevious)
  6. If Not rng Is Nothing Then
  7.     s = rng.Row
  8.     Range([a5], Cells(s, "s")).Cut (Cells(n + 1, 1))
  9.     Range([a5], Cells(s, "s")).Delete Shift:=xlUp
  10. End If
  11. End Sub
复制代码
回复

使用道具 举报

 楼主| 发表于 2015-2-28 14:34 | 显示全部楼层
dsmch 发表于 2015-2-28 05:29

老师:在排D列时,能否做到按日期顺序先排“入”字号,再排“出”字号。
回复

使用道具 举报

发表于 2015-2-28 17:01 | 显示全部楼层
  1. Sub Macro1()
  2. Dim rng As Range, n&, s&
  3. n = Range("b65536").End(xlUp).Row
  4. [d:d].Replace "入", "a入", lookat:=xlPart
  5. Range([b4], Cells(n, "s")).Sort Key1:=[b5], Key2:=[c5], Key3:=[d5], Header:=xlGuess
  6. Set rng = [b:b].Find(1, lookat:=xlWhole, searchdirection:=xlPrevious)
  7. [d:d].Replace "a入", "入", lookat:=xlPart
  8. If Not rng Is Nothing Then
  9.     s = rng.Row
  10.     Range([a5], Cells(s, "s")).Cut (Cells(n + 1, 1))
  11.     Range([a5], Cells(s, "s")).Delete Shift:=xlUp
  12. End If
  13. End Sub
复制代码
回复

使用道具 举报

 楼主| 发表于 2015-2-28 22:04 | 显示全部楼层
dsmch 发表于 2015-2-28 17:01

OK谢谢老师,辛苦了!!!!!!!!!!!
回复

使用道具 举报

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

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-29 02:50 , Processed in 0.723693 second(s), 9 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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