Excel 中自动阅卷的实现

        因单位要求，帮镇工会组织的“2008迎奥运，计算机操作竞赛”出试题。主要内容有打字、Word操作、Excel操作和PPT操作。由于参加竞赛的人员 较多，不可能为每一位选手手工评分，所以用Office中的VBA来实现各个模块试题的自动评分。现将各部分操作题目及VBA程序贴出。

Exce中实现自动评分
以下是Excel题目：

●注意：全文内容、位置不得随意变动，红框之内的文字不得做任何修改,否则影响批改成绩。
●共100分
1．在“A18”单元格输入标题“内资注册登记企业在各行业分布情况”的文字，并设置成黑体、蓝色、20号字；
2．合并“A18:G18”单元格，并设置水平和垂直居中。
3．在表格中“社会服务业”的前面增加一行数据“房地产业　36 4 4 0”
4．用公式求出各行业的“合计”数填入相应的单元格中；公司法人或单位的“平均值”填入相应的单元格(平均值保留两位小数)；计算有限公司在自己行业中的百分比填入相应单元格中,(百分比=有限公司/合计)并保留两位小数的百分比格式。
5．给表格(A19:G35)加上蓝色细实线的边框。
6．给当前表格19行“行业……”所在行设置行高为“25”，并把该行有文字的单元格设置“天蓝色底纹”。
7．表中的信息以“有限公司”为主要关键字，“分公司”为次要关键字进行降序排列；并把排行前３位的数据复制到sheet2中“A4”起始位置上，然后把sheet2改名为“３强”
8．在sheet3工作表中筛选出“营业单位”大于30而且“一般法人”大于等于85的行业。
9．在sheet4工作表的"B23:H40"位置,以“行业”和“合计”为数据建立一个“堆积柱型图”（要求系列产生在列，图表标题为“合计分析图”）
行业	有限公司	分公司	一般法人	营业单位	合计	百分比
农、林、牧、渔业	8	0	7	0
采掘业	0	3	3	0
制造业	111	28	90	33
电力、煤气及水的生产和供应业	2	1	0	1
建筑业	39	77	6	38
地址勘查业、水利管理业	0	0	1	1
交通运输、仓储及邮电通信业	9	21	3	76
批发和零售贸易、餐饮业	137	147	85	319
金融、保险业	6	10	3	7
社会服务业	52	39	42	50
卫生、体育和社会福利业	0	1	0	3
教育、文化艺术及广播电影电视业	1	1	6	8
科学研究和综合技术服务业	19	2	8	9
其他行业	7	5	1	3
平均

以下是Excel自动阅卷VBA代码：
  Score = 0
  ef = ""
  With Sheet1
      '题目1
      If .Range("A18:A18").Value = "内资注册登记企业在各行业分布情况" Then
         Score = Score + 5
         Else
           ef = ef & "第1题输入标题错误" & vbCrLf
      End If
      If .Range("A18:A18").Font.Name = "黑体" Then
         Score = Score + 3
         Else
           ef = ef & "第1题设置字体错误" & vbCrLf
      End If
       If .Range("A18:A18").Font.ColorIndex = 5 Then
         Score = Score + 3
         Else
           ef = ef & "第1题设置字体颜色错误" & vbCrLf
      End If
      If .Range("A18:A18").Font.Size = 20 Then
         Score = Score + 3
         Else
           ef = ef & "第1题设置字号错误" & vbCrLf
      End If
     
      '题目2
      If .Range("A18:G18").MergeCells = True Then
        Score = Score + 5
        Else: ef = ef & "第2题单元格合并错误" & vbCrLf
      End If
       If .Range("A18:G18").HorizontalAlignment = xlCenter Then
        Score = Score + 3
        Else: ef = ef & "第2题水平居中错误" & vbCrLf
      End If
      If .Range("A18:G18").VerticalAlignment = xlCenter Then
        Score = Score + 3
        Else: ef = ef & "第2题垂直居中错误" & vbCrLf
      End If
      
      '题目3
       Find = False
      For i = 20 To 35
        If .Cells(i, 1) = "房地产业" And .Cells(i, 2) = 36 And .Cells(i, 3) = 4 And .Cells(i, 4) = 4 And .Cells(i, 5) = 0 Then
        Score = Score + 5
        Find = True
        Exit For
        Else
          Find = False
        End If
      Next i
        If Find = False Then
        ef = ef & "第3题插入一行错误或数据输入错误" & vbCrLf
        End If
    
      
      '题目4
       If .Range("F20:F33").HasFormula = True And .Range("f20:F20").Value = .Cells(20, 2) + .Cells(20, 3) + .Cells(20, 4) + .Cells(20, 5) And .Range("f33:F33").Value = .Cells(33, 2) + .Cells(33, 3) + .Cells(33, 4) + .Cells(33, 5) Then
        Score = Score + 5
        Else
        ef = ef & "第4题计算合计错误" & vbCrLf
      End If
      a = 0
      s1 = 0
      s2 = 0
      s3 = 0
      s4 = 0
      s11 = 0
      s22 = 0
      s33 = 0
      s44 = 0
      For i = 20 To 33
      On Error Resume Next
        s1 = s1 + Sheet1.Cells(i, 2)
        s2 = s2 + Sheet1.Cells(i, 3)
        s3 = s3 + Sheet1.Cells(i, 4)
        s4 = s4 + Sheet1.Cells(i, 5)
        a = a + 1
      Next i
      s11 = s1 + Sheet1.Cells(34, 2)
       s22 = s2 + Sheet1.Cells(34, 3)
        s33 = s3 + Sheet1.Cells(34, 4)
         s44 = s4 + Sheet1.Cells(34, 5)
      s1 = s1 / a
      s11 = s11 / (a + 1)
      s2 = s2 / a
      s22 = s22 / (a + 1)
      s3 = s3 / a
      s33 = s33 / (a + 1)
      s4 = s4 / a
      s44 = s44 / (a + 1)
        
      If (.Range("B34:E34").HasFormula = True Or .Range("B35:E35").HasFormula = True) And (.Range("B34:B34").Value = s1 Or .Range("B35:B35").Value = s11) And (.Range("E34:E34").Value = s4 Or .Range("E35:E35").Value = s44) Then
        Score = Score + 5
        Else
        ef = ef & "第4题计算平均值错误" & vbCrLf
      End If
      If .Range("G20:G33").HasFormula = True And UCase(.Range("g20:g20").Formula) = UCase("=b20/f20") And UCase(.Range("g33:g33").Formula) = UCase("=b33/f33") Then
    
        Score = Score + 5
        Else
        ef = ef & "第4题计算百分比错误" & vbCrLf
      End If
      If InStr(1, .Range("B34:E34").NumberFormatLocal, "0.00_") > 0 Or InStr(1, .Range("B35:E35").NumberFormatLocal, "0.00_") > 0 Then
        Score = Score + 5
        Else
        ef = ef & "第4题平均值保留两位小数错误" & vbCrLf
      End If
      If Range("G20:G33").NumberFormatLocal = "0.00%" Then
         Score = Score + 5
         Else
         ef = ef & "第4题百分比保留两位小数错误" & vbCrLf
      End If
      
      '题目5
       With .Range("A19:G35")
       If .Borders(xlEdgeLeft).LineStyle = xlContinuous And .Borders(xlEdgeLeft).Weight = xlThin And .Borders(xlEdgeLeft).ColorIndex = 5 Then
          Score = Score + 5
          Else
          ef = ef & "第5题设置表格线错误" & vbCrLf
       End If
       End With
      
      '题目6
      If .Rows(19).RowHeight = 25 Then
        Score = Score + 5
        Else
        ef = ef & "第6题设置行高错误" & vbCrLf
      End If
      If .Range("A19:G19").Interior.ColorIndex = 33 Then
        Score = Score + 5
        Else
        ef = ef & "第6题设置19行单元格底纹颜色错误" & vbCrLf
      End If
      
      '题目7
       If .Range("A32:a32").Value = "采掘业" And .Range("B32:B32").Value = 0 And .Range("C32:C32").Value = 3 And .Range("A21:A21").Value = "制造业" Then
        Score = Score + 5
        Else
        ef = ef & "第7题排序错误或者其它原因引起此题批改错误" & vbCrLf
      End If
      If Sheet2.Range("A4:A4").Value = "批发和零售贸易、餐饮业" And Sheet2.Range("A5:A5").Value = "制造业" And Sheet2.Range("A6:A6").Value = "社会服务业" Then
        Score = Score + 5
        Else
        ef = ef & "第7题排序或者复制数据错误" & vbCrLf
      End If
      
      If Sheet2.Name = "3强" Then
         Score = Score + 5
         Else
         ef = ef & "第7题sheet2改名错误" & vbCrLf
      End If
      '题目8
      FLAG = True
      For i = 5 To 20
        If i <> 7 And i <> 12 Then
           If Sheet3.Rows(i).RowHeight <> 0 Then
              FLAG = False
              Exit For
           End If
        End If
      Next i
      If FLAG = True Then
          Score = Score + 5
          Else
          ef = ef & "第8题筛选错误" & vbCrLf
      End If
      
      '题目9
     FLAG = True
     If Sheet4.ChartObjects.Count <> 0 Then
       If Sheet4.ChartObjects(1).Chart.ChartType = xlColumnStacked Then
         Score = Score + 2
         Else
         FLAG = False
       End If
       If Sheet4.ChartObjects(1).Chart.SeriesCollection(1).Formula = "=SERIES(Sheet4!$G$5,Sheet4!$B$6:$B$20,Sheet4!$G$6:$G$20,1)" Then
         Score = Score + 2
         Else
         FLAG = False
       End If
       If Sheet4.ChartObjects(1).Chart.HasTitle = True Then
        If Sheet4.ChartObjects(1).Chart.ChartTitle.Characters.Text = "合计分析图" Then
         Score = Score + 2
          Else
         FLAG = False
       End If
       Else
         FLAG = False
       End If
      
        If Sheet4.ChartObjects(1).Chart.PlotBy = xlColumns Then
         Score = Score + 2
          Else
         FLAG = False
       End If
       If Sheet4.ChartObjects(1).Top > Sheet4.Range("B23:B23").Top And Sheet4.ChartObjects(1).Top < Sheet4.Range("B24:B24").Top And _
       Sheet4.ChartObjects(1).Left > Sheet4.Range("B23:B23").Left And Sheet4.ChartObjects(1).Left < Sheet4.Range("C23:C23").Left And _
       Sheet4.ChartObjects(1).Height > Sheet4.Range("B40:B40").Top - Sheet4.Range("B24:B24").Top And Sheet4.ChartObjects(1).Height < Sheet4.Range("B41:B41").Top - Sheet4.Range("B23:B23").Top And _
       Sheet4.ChartObjects(1).Width > Sheet4.Range("H23:H23").Left - Sheet4.Range("B24:B24").Left And Sheet4.ChartObjects(1).Width < Sheet4.Range("I23:I23").Left - Sheet4.Range("B23:B23").Left Then
         Score = Score + 2
          Else
         FLAG = False
       End If
       End If
       If FLAG = False Or Sheet4.ChartObjects.Count = 0 Then
         ef = ef & "第9题建立图表有错误"
       End If
  End With
 PgCount = PgCount + 1
 MsgBox "你的成绩为: " & Score & vbCrLf
 'a = MsgBox(ef, , "错误信息")