[已解决]vba先排序、再导出

武林长风 · 发表于 2014-12-7 11:55

本帖最后由武林长风于 2014-12-10 18:03 编辑

用一个代码对下列工作表先排序、再导出。
排序要求：
1、学校汇总表按学校的总名次排列：1、2、3、4、5、6……
2、英语、科学、品德、语数统计：各年级分别按名次排列：1、2、3、4、5、6……
3、及格率、优秀率：每一科都按百分比把学校由高到低排列。
导出要求：
在当前文件夹里（排序导出）新建一个导出数据工作簿，并复制“学校汇总表、英语统计、科学统计、思品统计、语数统计、及格率、优秀率”这几个工作表到新建的导出数据工作簿里。
所有的汇总要有表格的边框线。

排序导出.rar (45.56 KB, 下载次数: 9)

武林长风 · 发表于 2014-12-7 14:36

请帮忙啊！

武林长风 · 发表于 2014-12-7 18:27

{:1112:}{:1112:}

武林长风 · 发表于 2014-12-7 18:28

别沉下去了。{:2412:}

grf1973 · 发表于 2014-12-9 14:34

Sub tt()
Dim thwb As Workbook, wb As Workbook, sh As Worksheet
Set thwb = ThisWorkbook
Set wb = Workbooks.Add
thwb.Worksheets(Array("学校汇总表", "英语统计", "科学统计", "思品统计", "语数统计", "及格率", "优秀率")).Copy _
after:=wb.Sheets(wb.Sheets.Count) '工作表复制
For Each sh In wb.Worksheets
If sh.Name = "学校汇总表" Then '学校汇总表排序
r = sh.[a65536].End(3).Row
sh.Range("b4:aj" & r).Sort key1:=sh.[aj4]
ElseIf sh.Name Like "*统计" Then '英语统计，科学统计。。。。排序
r = sh.[a65536].End(3).Row
For i = 1 To r
If sh.Cells(i, 1) = "序号" Then
r1 = sh.Cells(i, 1).End(xlDown).Row
sh.Range(sh.Cells(i + 1, 2), sh.Cells(r1, "H")).Sort key1:=sh.Cells(i + 1, "G")
End If
Next
ElseIf sh.Name Like "*率" Then '及格率、优秀率排序
r = sh.[a65536].End(3).Row
For i = 1 To 9 Step 2
sh.Range(sh.Cells(3, i), sh.Cells(r, i + 1)).Sort key1:=sh.Cells(3, i + 1), order1:=xlDescending
Next
Else '删除多余工作表
Application.DisplayAlerts = False
sh.Delete
Application.DisplayAlerts = True
End If
Next
wb.SaveAs thwb.Path & "\排序.xls" '保存退出
wb.Close
End Sub

复制代码

grf1973 · 发表于 2014-12-9 14:35

这个最佳答案由 grf1973 给出，感谢 grf1973 的回答。

单击隐藏图章

请看附件。。。。。在源文件同目录下会生成“排序.xls”

武林长风 · 发表于 2014-12-10 18:02

grf1973 发表于 2014-12-9 14:35
请看附件。。。。。在源文件同目录下会生成“排序.xls”

谢谢老朋友的大力帮助！！！

武林长风 · 发表于 2014-12-10 18:11

本帖最后由武林长风于 2014-12-12 07:29 编辑

grf1973 发表于 2014-12-9 14:35
请看附件。。。。。在源文件同目录下会生成“排序.xls”

前面有了计算的代码，合在一起出现有的没边框。

武林长风 · 发表于 2014-12-11 13:37

grf1973 发表于 2014-12-9 14:35
请看附件。。。。。在源文件同目录下会生成“排序.xls”

请您再修改一下代码。

grf1973 · 发表于 2014-12-11 15:08

我自己运行的结果没问题啊。各统计表正确结果的前提是两个：
1、班与班之间有空行隔开
2、本班之间所有记录连续无空行。
只要你原来的表格边框什么的都齐全，那么排序之后的也是齐全的。
附件是排序后的结果，没发现什么问题。

		自动登录	找回密码
密码			注册

[已解决]vba先排序、再导出

评分