excel中使用宏把表中数据按某列排序,然后把同类数据复制至新的工作薄并保存

我的详细问题是这样的,就是我有一个excel表,例如首行为“姓名,学号,科目,成绩”类似这样的,然后下面每一行就是相应的数据。然后由于这个表太大,不方便查看,然后就想把所有数据按照科目来做一个类似于筛选的操作,再把同一科目的所有数据复制到新的工作薄中并按照这一科目名字保存工作薄,这样就能有几多个科目就有几多张工作薄,方便查看同一科目的相应数据!!
麻烦大家用心回答这一问题啊,很急着用的,记得记得要把相应的代码写上哦,到时就猛的加分加分,谢谢,非常感谢!!

第1个回答  2010-08-12
可以不用VBA,直接用函数公式效果也相同。
假定原始表sheet1的c列是科目(例:语文、数学...),在sheet2的a2输入:
=INDEX(sheet1!A:A,SMALL(IF(sheet1!$C$2:$C$65536=$C$1,ROW(sheet1!$A$2:$A$65536),4^8),ROW(A1)))&""
公式下拉右拉

说明:sheet2的c1输入你想查找的科目(例:语文);公式是数组公式,同时按下ctrl+shift+enter三键结束。
第2个回答  2010-08-13
请先做好备份。

Option Explicit

Sub Macro1()
'
' Macro1 Macro
' 宏由 yzvvj 录制,时间: 2010/8/13
'
Dim file1, file2, RowStart%, RowEnd%, SaveName
'
file1 = ActiveWorkbook.Name
Range("A1:D65536").Sort Key1:=Range("C1"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
SortMethod:=xlPinYin, DataOption1:=xlSortNormal
RowStart = 2
Do
Rows("1:1").Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Range("A2").Select
file2 = ActiveWorkbook.Name
Windows(file1).Activate
SaveName = Cells(RowStart, 3)
RowEnd = RowStart + 1
While (Cells(RowEnd, 3) = SaveName): RowEnd = RowEnd + 1: Wend
Rows(RowStart & ":" & RowEnd - 1).Select
Application.CutCopyMode = False
Selection.Copy
Windows(file2).Activate
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook.SaveAs Filename:=SaveName & ".xls", _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWindow.Close
RowStart = RowEnd
Loop While (Cells(RowStart, 3) <> "")
End Sub本回答被提问者采纳
第3个回答  2010-08-12
按照你的意思..就是一个表只有一个科目...
可以这样做:
1、复制多几个一模一样的表...
2、每个表都分别删除不同的科目,只留下一科(删除不同的列)
呵呵。。
第4个回答  2010-08-13
用宏代码也要有表格数据测试.这样吧,如果愿意HI我或将原始表格传我邮箱
[email protected]
相似回答