要舉行一個競賽，有參賽作品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

總結

以上是生活随笔為你收集整理的php显示评委打分情况代码,评委打分表自动汇总计算得分的全部內容，希望文章能夠幫你解決所遇到的問題。

如果覺得生活随笔網站內容還不錯，歡迎將生活随笔推薦給好友。