[已解决]数据分别排序后另存

ms967967

请求各位大侠帮助给写个VBA.
  要求将数据根据不同的列排序后将前8行另存到指定的区域。如附件

最佳答案

月排行榜 / 总排行榜

su45

2014-8-11 09:19

考虑了你的行数及列数：

1. Sub suaa()
   
2. i = cells(Rows.Count, 2).End(3).Row
   
3. j = cells(1, Columns.Count).End(1).Column
   
4. Set Rng = Range("B1", cells(i, j))
   
5. With Sheets("结果")
   
6.     .cells.Delete
   
7.     n = 1
   
8.     For i = 2 To j - 1
   
9.         Range(Rng(1, 1), Rng(Rng.Rows.Count, 1)).Copy .cells(1, n)
   
10.         Range(Rng(1, i), Rng(Rng.Rows.Count, i)).Copy .cells(1, n + 1)
    
11.         .Range(.cells(2, n), .cells(14, n + 1)).Sort .cells(2, n + 1), 2
    
12.         n = n + 6
    
13.     Next
    
14.     .Rows("10:100").Delete
    
15.     .Select
    
16. End With
    
17. End Sub
    

复制代码

跳转到最佳答案楼层

ms967967

忘记附件了 新建 Microsoft Excel 工作表.rar (10.96 KB, 下载次数: 7)

2014-8-6 19:48 上传

点击文件名下载附件

su45

为什么会有 “李四+周八” ？

ms967967

su45 发表于 2014-8-6 19:52
为什么会有 “李四+周八” ？

在我的实际应用中需要有一个求和后排序的过程，不知是否还有好的办法，如果不方便实现那就只实现排序后另存吧。

su45

怎么排序？关键字段是什么？升序？降序？

ms967967

su45 发表于 2014-8-6 20:05
怎么排序？关键字段是什么？升序？降序？

跟据人名降序排列，效果如附件中的结果

su45

是这种效果么？

新建 Microsoft Excel 工作表.zip (16.49 KB, 下载次数: 18)

2014-8-6 23:03 上传

点击文件名下载附件

ms967967

su45 发表于 2014-8-6 23:03
是这种效果么？

是这个效果，只是我 不需要这么多，只需要其中的几个人名，如只要王五和钱九两人的。

ms967967

su45 发表于 2014-8-6 23:03
是这种效果么？

谢谢SU45老师的帮助，
在实际应用过程中我的数据量行数不固定，最多时也要60多行，而且每天都会更新，能否在您的VBA中增加一个变量的设置，谢谢支持

su45

考虑了你的行数及列数：

1. Sub suaa()
   
2. i = cells(Rows.Count, 2).End(3).Row
   
3. j = cells(1, Columns.Count).End(1).Column
   
4. Set Rng = Range("B1", cells(i, j))
   
5. With Sheets("结果")
   
6.     .cells.Delete
   
7.     n = 1
   
8.     For i = 2 To j - 1
   
9.         Range(Rng(1, 1), Rng(Rng.Rows.Count, 1)).Copy .cells(1, n)
   
10.         Range(Rng(1, i), Rng(Rng.Rows.Count, i)).Copy .cells(1, n + 1)
    
11.         .Range(.cells(2, n), .cells(14, n + 1)).Sort .cells(2, n + 1), 2
    
12.         n = n + 6
    
13.     Next
    
14.     .Rows("10:100").Delete
    
15.     .Select
    
16. End With
    
17. End Sub
    

复制代码