想用excel制作一个考试系统，现在不知道怎样形成成绩汇总表！！急！！求大师指教！！-《别怕，Excel其实很简单》系列论坛-ExcelHome技术论坛

2014-7-24 21:20 关注

我想用excel 制作一个简易的考试系统，现在遇到了一个问题。
根据从不同部门人员收回的考试答卷，在答卷上自动计算出每个人的总成绩（都显示在K45单元格）。
现在需要从每张答卷的总成绩提取出来，汇总在另一张新表（成绩统计表）中。
在网上查了很久，都没法解决！
请问哪位大师能帮我写个宏代码出来？非常非常感谢啊。
这是老板交给我的任务，求帮忙啊！！！！

批量提取总分.rar 2014-7-24 21:15 上传

28.37 KB, 下载次数: 57

赏

计算代码 excel 制作一个

3351阅读

TomingTang Lv.5 2楼

2014-7-24 22:06

我改了一下以前的程序，程序比较乱，符合你的要求了。你看看。。

Sub 汇总()
Dim Arr(1 To 1000, 1 To 2), i%, j%, drow%, Erow%, eerow%
Dim filename As String, wb As Workbook, sht As Worksheet, shtname As String
Dim fn As String, d, k, str As String
' Set d = CreateObject("Scripting.Dictionary")
'关闭屏幕闪烁和警告框
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'On Error GoTo VeryEnd
' ThisWorkbook.Worksheets("sheet1").Range("a2:y550000").ClearContents '清除汇总表中原来的数据
i = 1
filename = Dir(ThisWorkbook.Path & "\*.xls")
Do While filename <> ""
If filename <> ThisWorkbook.Name Then '判断文件是否是本工作簿
fn = ThisWorkbook.Path & "" & filename
Set wb = GetObject(fn) '将fn代表的工作簿对象赋给变量
Set sht = wb.Sheets(1)
' drow = sht.[a65536].End(3).Row
' MsgBox drow
Arr(i, 1) = sht.Name
Arr(i, 2) = sht.[k45].Value
i = i + 1
wb.Close False
End If
filename = Dir
Loop
VeryEnd:
ThisWorkbook.Worksheets("sheet1").Range("a2").Resize(UBound(Arr, 1), 2) = Arr
MsgBox "汇总完成，请查看"
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub