【代码】VBA自定义函数：考试多项选择题判分；山东高考数学多选题判分解决方法

文摘教育 2024-10-10 22:35 江苏

点【关于本公众号】了解一下，欢迎关注，谢谢！

快速浏览

实用案例

|日期控件 ||简单的收发存||收费管理系(Access改进版)|

|电子发票管理助手||电子发票登记系统(Access版)|

|文件合并 ||表格拆分 ||审计凭证抽查底稿|

|中医诊所收费系统(Excel版)||中医诊所收费系统(Access版)||银行对账单自动勾对|

|印章使用登记系统|

收费使用项目

|财务管理系统||工资薪金和年终奖个税筹划||新税法下工资表模版|

内容提要

考试多选题判分|完整代码

1、在工作表“Sheet1”里，命令按钮点击事件，工作表Change事件，调用判分过程：

Private Sub CmdScore_Click()    Dim arr(), i As Long, rng As Range    Dim lRow As Long    lRow = UsedRange.Rows.Count    Set rng = Cells(1, 1).Resize(lRow, 4)    arr = rng.Value    For i = 2 To UBound(arr)        arr(i, 4) = getScore(6, CStr(arr(i, 3)), CStr(arr(i, 2)))    Next    rng.Value = arr    MsgBox "Done!"End Sub
Private Sub Worksheet_Change(ByVal Target As Range)    Dim currRow As Long    If Target.CountLarge > 1 Then Exit Sub    If Target.Row > 1 Then        If Target.Column = 2 Or Target.Column = 3 Then            currRow = Target.Row            Cells(currRow, 4) = getScore(6, CStr(Cells(currRow, 3)), CStr(Cells(currRow, 2)))        End If    End IfEnd Sub

2、在myModule里，getScore自定义函数，根据相应参数得出分数：

Option ExplicitFunction getScore( _        totalScore As Integer, _        rightAnswer As String, _        studentAnswer As String)    '//totalScore:单题总分    '//rightAnswer：正确答案    '//studentAnswer：学生答案    Dim unitScore As Double    Dim currScore As Double    Dim i As Integer        '//答案都转为大写    rightAnswer = UCase(rightAnswer)    studentAnswer = UCase(studentAnswer)        '//如果标准答案为空，退出函数    If rightAnswer = "" Then Exit Function        '//每个选项得分    unitScore = Round(totalScore / Len(rightAnswer), 2)    If studentAnswer = "" Or Len(studentAnswer) > Len(rightAnswer) Then            '//如果学生答案为空或者多于标准答案，得0分        getScore = 0        Exit Function    End If        '//循环判断学生答案的每个选项，如果没有错误选项，按答对个数得分，    '//否则，得0分    For i = 1 To Len(studentAnswer)        If InStr(rightAnswer, Mid(studentAnswer, i, 1)) > 0 Then            currScore = currScore + unitScore        Else            getScore = 0            Exit Function        End If    Next    getScore = currScoreEnd Function

在这个案例中，我们使用了工作表Change事件，但跟昨天的案例【更新：科目余额表逐级汇总，工作表Change事件，自动刷新汇总数据；Application.EnableEvents属性】有所不同，我们没有用EnableEvents属性，运行速度也没有影响，原因是我们工作表Change事件中的Target只是第2、第3列，在点击命令按钮批量得分的时候，第2、第3列的值是不会变的，应该不会触发工作表的Change事件。

~~~~~~End~~~~~~

	安利小店安利的牙膏非常不错，用了以后就不想再用其他的了；洗洁精、洗衣液也是日常必备，用过都说好！
	合谷医疗合谷医疗专攻各种疑难杂症，尤其擅长抑郁症、焦虑失眠、儿童神经发育异常、多动症、自闭孤独症、腰颈椎疾病治疗，可谓神乎其技！体验过的直呼早点来就好了！

喜欢就点个赞、点在看、留言评论、分享一下呗！感谢支持！

Excel问题，请在文章下面留言讨论！或者加入我的付费交流群提问！
如需案例文件，请按当天另一篇文章末尾案例文件分享说明操作！

http://mp.weixin.qq.com/s?__biz=MzIwMjIzMzI1OA==&mid=2247489275&idx=2&sn=31679c20dac60f52eab3e5b7a67c4be1

VBA编程实战

Excel应用案例、Excel VBA、公式函数使用技巧分享，思路解读...... 这里有鲜活案例、实用的技巧......

最新文章

想知道你对哪些食物过敏吗？食物特异性抗体IgG4检测试剂盒（蛋白芯片法）

「案例更正」SQL查询汇总EXCEL表数据：出入库统计增加上年库存统计并按名称排序

「代码更正」SQL查询汇总EXCEL表数据：出入库统计增加上年库存统计并按名称排序

财务审计业务，往来科目重分类，数组、字典综合应用

「代码」财务审计业务，往来科目重分类，数组、字典综合应用

「案例更新」客户销售额查询分析：ComboBox下拉列表，模糊搜索；统计查看表数据按不同方式排序

「代码更新」客户销售额查询分析：ComboBox下拉列表，模糊搜索；统计查看表数据按不同方式排序

EXCEL VBA操作ACCESS数据库，操作表(创建、修改、删除)，ADO的OpenSchema方法，获取所有表名【扩展篇】

「代码」EXCEL VBA操作ACCESS数据库表(创建、修改、删除)，ADO的OpenSchema方法，获取所有表名【扩展篇】

EXCEL VBA操作ACCESS数据库，获取表头字段，SQL查询语句自定义函数【提高篇】

「代码」EXCEL VBA操作ACCESS数据库，获取表头字段，SQL查询语句自定义函数【提高篇】

客户销售额查询分析：ComboBox下拉列表，数组字典综合应用

「代码」客户销售额查询分析：ComboBox下拉列表，数组字典综合应用

SQL查询汇总EXCEL表数据：出入库统计增加上年库存统计并按名称排序

「代码」SQL查询汇总EXCEL表数据：出入库统计增加上年库存统计并按名称排序

「案例更新」VBA操作Word表格：把运动员名单表按指定格式导出到Word文档

「代码」（更新1）VBA操作Word表格：把运动员名单表按指定格式导出到Word文档

「代码」（更新2）VBA操作Word表格：把运动员名单表按指定格式导出到Word文档

代替VLOOKUP函数，用Application.Match怎么样？结果却大大出乎我的意料！

「代码」代替VLOOKUP函数，用Application.Match怎么样？结果却大大出乎我的意料！

提取各科成绩第一名的记录，Application.Index函数提取数组整行整列

「代码」「数组法」提取各科成绩第一名的记录，Application.Index函数提取数组整行整列

「代码」「SQL法」提取各科成绩第一名的记录

数组动态扩展、字典综合应用：订单金额达标插入赠品！

【代码】数组动态扩展、字典综合应用：订单金额达标插入赠品！

EXCEL VBA操作ACCESS数据库，实现增删改查【基础篇】（免费）！

【代码】EXCEL VBA操作ACCESS数据库，实现增删改查【基础篇】（免费）！

往来账清账勾对，字典实例详解，把多个单元格区域组合装入字典

【代码】往来账清账勾对，字典实例详解，把多个单元格区域组合装入字典

有人想付费学习字典，我觉得没啥必要，再谈字典Dictonary（免费）！

别再炒股啦，去南极终极探险吧！

VBA批量循环打印奖状：根据原表数据和奖状模板，逐份打印所有学生奖状，数组、字典应用

【代码】VBA批量循环打印奖状：根据原表数据和奖状模板，逐份打印所有学生奖状，数组、字典应用

VBA自定义函数：考试多项选择题判分；山东高考数学多选题判分解决方法

【代码】VBA自定义函数：考试多项选择题判分；山东高考数学多选题判分解决方法

更新：科目余额表逐级汇总，工作表Change事件，自动刷新汇总数据；Application.EnableEvents属性

【代码】更新：科目余额表逐级汇总，工作表Change事件，自动刷新汇总数据；Application.EnableEvents属性

逐级汇总（数组、字典）：财务同学看过来，科目余额表逐级汇总

【代码】逐级汇总（数组、字典）：财务同学看过来，科目余额表逐级汇总

这个功能有点强悍！合并工作表：按指定字段合并文件夹下所有Excel文件、CSV文件，包含所有子文件夹

【代码】这个功能有点强悍！合并工作表：按指定字段合并文件夹下所有Excel文件、CSV文件，包含所有子文件夹

教师工作量统计：有点晕！我要这样做，四级嵌套字典，逐级拼接成一个字符串，设置单元格内指定文本的格式

【代码】教师工作量统计：有点晕！我要这样做，四级嵌套字典，逐级拼接成一个字符串，设置单元格内指定文本的格式

数据匹配：不用字典，如何查找日期相同、数值相近的数据？

【代码】数据匹配：不用字典，如何查找日期相同、数值相近的数据？

举一反三，简单的案例「复杂化」，这样学习VBA效果杠杠的！查询时间最近的记录：如何提取所有车牌号最近时间的手机号

【代码1】数据查询「方法1」：字典+SortedList，查询最近时间手机号

【代码2】数据查询「方法2」：工作表排序+字典，查询最近时间手机号

【代码3】数据查询「方法3」：ADO对象+SQL，查询最近时间手机号

分类

时事

民生

政务

教育

文化

科技

财富

体娱

健康

情感

旅行

百科

职场

楼市

企业

乐活

学术

汽车

时尚

创业

美食

幽默

美体

文摘

原创标签

时事社会财经军事教育体育科技汽车科学房产搞笑综艺明星音乐动漫游戏时尚健康旅游美食生活摄影宠物职场育儿情感小说曲艺文化历史三农文学娱乐电影视频图片新闻宗教电视剧纪录片广告创意壁纸头像心灵鸡汤星座命理教育培训艺术文化金融财经健康医疗美妆时尚餐饮美食母婴育儿社会新闻工业农业时事政治星座占卜幽默笑话独立短篇连载作品文化历史科技互联网

发布位置

广东北京山东江苏河南浙江山西福建河北上海四川陕西湖南安徽湖北内蒙古江西云南广西甘肃辽宁黑龙江贵州新疆重庆吉林天津海南青海宁夏西藏香港澳门台湾美国加拿大澳大利亚日本新加坡英国西班牙新西兰韩国泰国法国德国意大利缅甸菲律宾马来西亚越南荷兰柬埔寨俄罗斯巴西智利卢森堡芬兰瑞典比利时瑞士土耳其斐济挪威朝鲜尼日利亚阿根廷匈牙利爱尔兰印度老挝葡萄牙乌克兰印度尼西亚哈萨克斯坦塔吉克斯坦希腊南非蒙古奥地利肯尼亚加纳丹麦津巴布韦埃及坦桑尼亚捷克阿联酋安哥拉