VBA宏无法统计选择题考试正确答题数问题求助

问题描述 #

我开发的选择题考试项目采用6个命令按钮作为答题选项，题目、四个备选答案及正确答案存储在隐藏工作表中。目前按钮功能正常，但宏无法统计用户完成1-10题的正确答题数量，需要实现以下功能：

• 统计用户的正确答题数
• 在独立的UserForm「SCORE」中显示该数值
• 将最终分数写入SCORE工作表

现有代码 #

Option Explicit

Private btnClicked As String 'A, B, C, D
Private questionNo As Integer
Private question As String, code As String
Private choiceA, choiceB, choiceC, choiceD As String
Private answer As String

Private Sub cmdA_Click()
'&H00C0FFFF& 'Normal
'&H0000FF00& 'Selected

cmdA.BackColor = &HFF00&
cmdB.BackColor = &HC0FFFF
cmdC.BackColor = &HC0FFFF
cmdD.BackColor = &HC0FFFF
btnClicked = "Answer: A"""
End Sub

Private Sub cmdB_Click()
cmdA.BackColor = &HC0FFFF
cmdB.BackColor = &HFF00&
cmdC.BackColor = &HC0FFFF
cmdD.BackColor = &HC0FFFF
btnClicked = "Answer: B"""
End Sub

Private Sub cmdC_Click()
cmdA.BackColor = &HC0FFFF
cmdB.BackColor = &HC0FFFF
cmdC.BackColor = &HFF00&
cmdD.BackColor = &HC0FFFF
btnClicked = "Answer: C"""
End Sub

Private Sub cmdD_Click()
cmdA.BackColor = &HC0FFFF
cmdB.BackColor = &HC0FFFF
cmdC.BackColor = &HC0FFFF
cmdD.BackColor = &HFF00&
btnClicked = "Answer: D"""
End Sub

Sub resetButton()
cmdA.BackColor = &HC0FFFF
cmdB.BackColor = &HC0FFFF
cmdC.BackColor = &HC0FFFF
cmdD.BackColor = &HC0FFFF
End Sub

Private Sub cmdSubmit_Click()
'Check if user click an option
If cmdA.BackColor = &HFF00& Or cmdB.BackColor = &HFF00& Or _
cmdC.BackColor = &HFF00& Or cmdD.BackColor = &HFF00& Then

'Move to the next question
questionNo = questionNo + 1
Label1.Caption = "Question " & questionNo & " of 10"

If cmdSubmit.Caption = "Submit" Then
Call get_quiz
Else

'Save the quiz result to record sheet
Dim lRow As Integer
lRow = rSH.Range("A" & Rows.Count).End(xlUp).Row + 1
rSH.Range("A" & lRow).Value = username
rSH.Range("B" & lRow).Value = Now
rSH.Range("C" & lRow).Value = score


frm_score.lblName = username
frm_score.lblScore = score
frm_score.Show
Unload Me
End If

Else
MsgBox "Please select an answer.", vbExclamation, mTitle
End If
End Sub

Private Sub UserForm_Initialize()
questionNo = 1
score = 0
Call init_SH
Call get_quiz
End Sub

Sub get_quiz()
Call resetButton
Dim lRow As Integer
lRow = questionNo + 1

question = qSH.Range("A" & lRow).Value

'code = qSH.Range("B" & lRow).Value
choiceA = qSH.Range("B" & lRow).Value
choiceB = qSH.Range("C" & lRow).Value
choiceC = qSH.Range("D" & lRow).Value
choiceD = qSH.Range("E" & lRow).Value
answer = qSH.Range("F" & lRow).Value

txtQuestion.Value = question
'txtSampleCode.Value = code          '<<<<<<<<<<<<<<<<<<<<<<<<
cmdA.Caption = choiceA
cmdB.Caption = choiceB
cmdC.Caption = choiceC
cmdD.Caption = choiceD

If questionNo = 10 Then
'Last question
cmdSubmit.Caption = "End Exam"
End If
End Sub

解决方案 #

关键问题分析 #

1. btnClicked赋值错误：原代码中多了冗余双引号和前缀，导致无法和正确答案直接对比
2. score未声明为模块级变量：无法跨过程累计分数
3. 缺少答题判分逻辑：提交时未校验用户选择是否正确

修改步骤及代码 #

1. 修正模块级变量声明，添加score变量
2. 修正按钮点击事件的btnClicked赋值，简化为纯选项标识
3. 在提交逻辑中添加判分代码，累计正确数
4. 优化UserForm控件赋值方式，确保属性设置正确

修改后的完整代码：

Option Explicit

Private btnClicked As String 'A, B, C, D
Private questionNo As Integer
Private question As String, code As String
Private choiceA, choiceB, choiceC, choiceD As String
Private answer As String
Private score As Integer '新增：模块级分数变量

Private Sub cmdA_Click()
cmdA.BackColor = &HFF00&
cmdB.BackColor = &HC0FFFF
cmdC.BackColor = &HC0FFFF
cmdD.BackColor = &HC0FFFF
btnClicked = "A" '修正：去掉冗余内容
End Sub

Private Sub cmdB_Click()
cmdA.BackColor = &HC0FFFF
cmdB.BackColor = &HFF00&
cmdC.BackColor = &HC0FFFF
cmdD.BackColor = &HC0FFFF
btnClicked = "B" '修正：去掉冗余内容
End Sub

Private Sub cmdC_Click()
cmdA.BackColor = &HC0FFFF
cmdB.BackColor = &HC0FFFF
cmdC.BackColor = &HFF00&
cmdD.BackColor = &HC0FFFF
btnClicked = "C" '修正：去掉冗余内容
End Sub

Private Sub cmdD_Click()
cmdA.BackColor = &HC0FFFF
cmdB.BackColor = &HC0FFFF
cmdC.BackColor = &HC0FFFF
cmdD.BackColor = &HFF00&
btnClicked = "D" '修正：去掉冗余内容
End Sub

Sub resetButton()
cmdA.BackColor = &HC0FFFF
cmdB.BackColor = &HC0FFFF
cmdC.BackColor = &HC0FFFF
cmdD.BackColor = &HC0FFFF
btnClicked = "" '新增：重置选中记录
End Sub

Private Sub cmdSubmit_Click()
'Check if user click an option
If cmdA.BackColor = &HFF00& Or cmdB.BackColor = &HFF00& Or _
cmdC.BackColor = &HFF00& Or cmdD.BackColor = &HFF00& Then

'新增：判分逻辑 - 校验当前题目答案
If UCase(btnClicked) = UCase(answer) Then
    score = score + 1
End If

'Move to the next question
questionNo = questionNo + 1
Label1.Caption = "Question " & questionNo & " of 10"

If cmdSubmit.Caption = "Submit" Then
    Call get_quiz
Else
    'Save the quiz result to record sheet
    Dim lRow As Integer
    lRow = rSH.Range("A" & Rows.Count).End(xlUp).Row + 1
    rSH.Range("A" & lRow).Value = username
    rSH.Range("B" & lRow).Value = Now
    rSH.Range("C" & lRow).Value = score

    frm_score.lblName.Caption = username '修正：设置控件Caption属性
    frm_score.lblScore.Caption = "得分：" & score & "/10" '优化显示格式
    frm_score.Show
    Unload Me
End If

Else
MsgBox "请选择一个答案。", vbExclamation, "提示"
End If
End Sub

Private Sub UserForm_Initialize()
questionNo = 1
score = 0
Call init_SH
Call get_quiz
End Sub

Sub get_quiz()
Call resetButton
Dim lRow As Integer
lRow = questionNo + 1

question = qSH.Range("A" & lRow).Value
choiceA = qSH.Range("B" & lRow).Value
choiceB = qSH.Range("C" & lRow).Value
choiceC = qSH.Range("D" & lRow).Value
choiceD = qSH.Range("E" & lRow).Value
answer = qSH.Range("F" & lRow).Value

txtQuestion.Value = question
cmdA.Caption = choiceA
cmdB.Caption = choiceB
cmdC.Caption = choiceC
cmdD.Caption = choiceD

If questionNo = 10 Then
    'Last question
    cmdSubmit.Caption = "结束考试"
End If
End Sub

额外注意事项 #

• 确保init_SH过程中正确设置工作表引用，示例：

  Sub init_SH()
      Set qSH = ThisWorkbook.Sheets("题目表") '替换为实际题目工作表名称
      Set rSH = ThisWorkbook.Sheets("SCORE")
      qSH.Visible = xlSheetHidden '隐藏题目表
  End Sub
  

• 确认username变量已在合适位置赋值（如登录环节或表单初始化时）
• SCORE工作表建议提前设置表头：A列「用户名」、B列「考试时间」、C列「得分」

内容的提问来源于stack exchange，提问作者Jerry