要举行一个竞赛，有参赛作品70个左右，请10多个评委打分，每个评委是一个xls文件，打分表里面具体是7个分项目，每个项目有上限。在论坛里看到一个帖子是将评分表和汇总表放在一个文件夹里自动汇总的，我模仿了一下，但是不成功……完全不懂这些什么代码，有些地方不知道怎么改。
现将文件和代码发上来，请大神们指教。
01.png (3.23 KB, 下载次数: 13)
-4-23 16:26 上传
02.png (18.36 KB, 下载次数: 2)
-4-23 16:27 上传
附件：
初审汇总.rar
(40.36 KB, 下载次数: 49)
-4-23 16:27 上传
点击文件名下载附件
Sub 合并数据()
Dim s$, cn As Object, m&, s1$
m = 2
Application.ScreenUpdating = False
Set xlApp = New Excel.Application
'Set xlBook = xlApp.Workbooks.Open(ThisWorkbook.Path &"\" & "初审评分统计表.xls")
Worksheets("sheet2").Select
Range("a5:z65536") =""
Set cn = CreateObject("adodb.connection")
s = Dir(ThisWorkbook.Path & "\*.xls")
Do
If InStr(1, s, "汇总") = 0 Then
'MsgBox ThisWorkbook.Path& "\" & s
cn.Open"provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;datasource=" & ThisWorkbook.Path & "\" & s
s1 = "select '"& s & "',* from [sheet1$a1:i80]"
Worksheets("sheet2").Select
'MsgBox s1
Sheets(2).Range("a" & m).CopyFromRecordset cn.Execute(s1)
m =Range("a65536").End(xlUp).Row + 1
cn.Close
End If
s = Dir
Loop Until Len(s) = 0
Worksheets("sheet1").Select
cn.Open"provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;datasource=" & ThisWorkbook.Path & "\" & "初审评分统计表.xls"
s ="select作品编号,作品名称,avg(标准1),avg(标准2),avg(标准3),avg(标准4),avg(标准5),avg(标准6),avg(标准7) from [sheet2$a1:z65536] group by作品编号,作品名称"
Sheets(1).Range("a5").CopyFromRecordset cn.Execute(s)
Application.ScreenUpdating= True
MsgBox "评价分数统计完毕！"
End Sub
Sub 数据清零()
Worksheets("sheet2").Select
Range("a2:z65536") = ""
Worksheets("sheet1").Select
Range("a6:z65536") = ""
End Sub
Sub 文件复制()
Dim myFolder As String
Dim xlsFile As String
Dim I As Integer
xlsFile = Dir(ActiveWorkbook.Path& "\初审评分表01.xls")
For I = 2 To 15
If I <= 9 Then
FileCopyThisWorkbook.Path & "\" & xlsFile, ThisWorkbook.Path &"\初审评分表0" & I& ".xls"
Else
FileCopy ThisWorkbook.Path& "\" & xlsFile, ThisWorkbook.Path & "\初审评分表" & I & ".xls"
End If
Next
End Sub
Sub 数据检验()
Worksheets("sheet2").Select
zjl =Range("a65536").End(xlUp).Row
For I = 2 To zjl
For J = 4 To 10
If Cells(I, J) = 0Then
MsgBox "第二工作表中第" & I & "行" & " 第" & J& "列，数据有逻辑错误，原因没录入数据.数据值为:" & Cells(I, J)
End If
Next J
For J = 4 To 4
If Cells(I, J)> 30 Then
MsgBox "第二工作表中第" & I & "行" & " 第" & J& "列，数据有逻辑错误，原因录入数据大于上限30.数据值为:" & Cells(I, J)
End If
Next J
For J = 5 To 5
If Cells(I, J)> 20 Then
MsgBox "第二工作表中第" & I & "行" & " 第" & J& "列，数据有逻辑错误，原因录入数据大于上限20.数据值为:" & Cells(I, J)
End If
Next J
For J = 6 To 10
If Cells(I, J)> 10 Then
MsgBox "第二工作表中第" & I & "行" & " 第" & J& "列，数据有逻辑错误，原因录入数据大于上限10.数据值为:" & Cells(I, J)
End If
Next J
Next I
MsgBox "检查完毕，没有发现逻辑错误"
End Sub
