php显示评委打分情况代码,评委打分表自动汇总计算得分

要举行一个竞赛，有参赛作品70个左右，请10多个评委打分，每个评委是一个xls文件，打分表里面具体是7个分项目，每个项目有上限。在论坛里看到一个帖子是将评分表和汇总表放在一个文件夹里自动汇总的，我模仿了一下，但是不成功……完全不懂这些什么代码，有些地方不知道怎么改。

现将文件和代码发上来，请大神们指教。

01.png (3.23 KB, 下载次数: 13)

2015-4-23 16:26 上传

02.png (18.36 KB, 下载次数: 2)

2015-4-23 16:27 上传

附件：

初审汇总.rar

(40.36 KB, 下载次数: 49)

2015-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