ExcelTip.Net留存知识帖 ---【注:附件之前被网盘供应商清空后,现已修复-现已修复-现已修复为本地下载!】
现在位置:首页 > 我的酷贴 > Excel VBA > 一个简易的自动阅卷评分程序

一个简易的自动阅卷评分程序

作者:绿色风 分类: 时间:2022-08-18 浏览:99
楼主
omnw
通过本代码,可以实现自动的阅卷评分。

首先,在一个单独的工作表中录入标准答案。

 
然后,在单独的工作表中录入每位考生的考试答案。

 
在汇报表中通过点击按钮运行代码,完成阅卷评分工作。

 

自动阅卷统分.rar
  1. Sub 按钮1_Click()
  2.     Dim i As Integer, j As Integer, k As Integer, Rngs As Range, MyCol As Integer
  3.     Dim rng As Range, sh As Worksheet, sht As Worksheet, MyCount As Integer
  4.     Dim SRow As Integer, ORow As Integer, FZ As Integer
  5.     Set sh = Worksheets("考生答案")
  6.     Set sht = Worksheets("标准答案")
  7.     For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
  8.         For j = 2 To 4
  9.             MyCount = 0    '保存考试成绩
  10.             Set rng = sh.Rows(2).Find(Cells(i, 1), lookat:=xlWhole)    '确定考生答案所在的位置
  11.             If Not rng Is Nothing Then
  12.                 Select Case Cells(1, j)    '判断题型
  13.                 Case "单选得分"
  14.                     Set Rngs = sht.Range("B2:K9")    '标准答案位置
  15.                     SRow = 3    '考生答案开始位置
  16.                     ORow = 42    '考生答案结束位置
  17.                     FZ = 1    '考题分值
  18.                 Case "多选得分"
  19.                     Set Rngs = sht.Range("B10:K12")
  20.                     SRow = 43
  21.                     ORow = 57
  22.                     FZ = 2
  23.                 Case "判断得分"
  24.                     Set Rngs = sht.Range("B13:K15")
  25.                     SRow = 58
  26.                     ORow = 72
  27.                     FZ = 2
  28.                 End Select
  29.                 MyCol = rng.Column    '考生答案所在的数据列
  30.                 For k = SRow To ORow    '开始统计某一种题型的答案
  31.                     Set rng = Rngs.Find(sh.Cells(k, 1), lookat:=xlWhole)    '在标准答案区查找题号
  32.                     If Not rng Is Nothing Then
  33.                         If rng.Offset(0, 1) = sh.Cells(k, MyCol) Then    '如果考生答案与标准答案一致
  34.                             MyCount = MyCount + FZ    '累计该题型的分数
  35.                         End If
  36.                     End If
  37.                 Next k
  38.             End If
  39.             Cells(i, j) = MyCount    '输出得分
  40.         Next j
  41.     Next i
  42. End Sub


该帖已经同步到
2楼
lrlxxqxa
3楼
JOYARK1958
謝謝提供學習下載中
4楼
五〇高手
学习
5楼
love_liwu
厉害,下载下来学习下。
6楼
qian倩与cpa之约
很好很强大,下载来学习学习!
7楼
大雪纷飞
很不错**!
8楼
HJGavin
多谢,多谢啦
9楼
letty1985
努力学习中
10楼
gysegz
本社区总是不乏高人,而且总是有一群热心人,无私的人**!顶起
11楼
kpwqm
努力学习VBA
12楼
鸿恒之心
厉害啊!
13楼
when-shine
omnw高手啊!我对VB编程还只停留在录制,要向你们学习。
14楼
omnw
客气了,共同学习。
15楼
ycs
努力学习中
16楼
hahappy
这个要顶一下,不过刚开始这些变成的,想问问在哪里编的?需要另外下载个VBA?
17楼
/ty有谁共鸣
太牛了

免责声明

有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素, 经与ExcelTip.Net站长Apolloh商议并征得其同意, 现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示, 供有需要的人士查询使用,也慰缅曾经的论坛时代。 所示各个帖子的原作者如对版权有异议, 可与本人沟通提出,或于本站点留言,我们会尽快处理。 在此,感谢ExcelTip.Net站长Apolloh的支持,感谢本站点所有人**绿色风(QQ:79664738)**的支持与奉献,特此鸣谢!
------本人网名**KevinChengCW(QQ:1210618015)**原ExcelTip.Net总版主之一

评论列表
sitemap