Excel宏开发需求：匹配题目答案并高亮Col-A对应选项

需求说明 #

• Col-A列包含500道题的题目编号（如1、2、3）及对应A/B/C/D四个选项，每道题的结构为：题目编号行 → 选项A行 → 选项B行 → 选项C行 → 选项D行
• Col-B列是待处理的题目编号列表，Col-C列是对应题目的正确答案（取值为A/B/C/D）
• 需编写Excel宏，自动遍历Col-B与Col-C的所有题目-答案对，在Col-A中定位到对应题目下的正确选项单元格，并将其填充为绿色高亮

数据示例 #

ColA     ColB   ColC  
1        1      B
A        2      A
B        3      A
C
D

2
A
B
C
D

3
A
B
C
D

VBA宏代码实现 #

Sub HighlightCorrectAnswers()
    Dim ws As Worksheet
    Dim answerDict As Object
    Dim lastRowB As Long, lastRowA As Long
    Dim i As Long, j As Long
    Dim questionNum As String, correctAns As String
    
    ' 设置当前工作表，可根据实际修改Sheet名称
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    ' 创建字典存储题目编号与正确答案的对应关系
    Set answerDict = CreateObject("Scripting.Dictionary")
    
    ' 读取Col-B和Col-C的题目-答案对到字典
    lastRowB = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    For i = 2 To lastRowB ' 假设第一行是表头
        questionNum = Trim(ws.Cells(i, "B").Value)
        correctAns = Trim(ws.Cells(i, "C").Value)
        If questionNum <> "" And correctAns <> "" Then
            answerDict(questionNum) = correctAns
        End If
    Next i
    
    ' 遍历Col-A查找题目并高亮正确选项
    lastRowA = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    i = 2 ' 假设第一行是表头
    Do While i <= lastRowA
        questionNum = Trim(ws.Cells(i, "A").Value)
        ' 判断当前行是否为题目编号
        If answerDict.Exists(questionNum) Then
            correctAns = answerDict(questionNum)
            ' 向下查找对应选项（题目行后第1-4行分别是A、B、C、D选项）
            For j = 1 To 4
                If i + j > lastRowA Then Exit For
                ' 匹配选项内容与正确答案
                If UCase(Trim(ws.Cells(i + j, "A").Value)) = UCase(correctAns) Then
                    ' 设置单元格填充色为绿色
                    ws.Cells(i + j, "A").Interior.ColorIndex = 4
                    Exit For
                End If
            Next j
            ' 跳过当前题目的选项行，直接到下一个题目
            i = i + 5
        Else
            i = i + 1
        End If
    Loop
    
    ' 释放对象
    Set answerDict = Nothing
    Set ws = Nothing
    MsgBox "批量高亮完成！", vbInformation
End Sub

代码说明 #

• 使用Scripting.Dictionary存储题目编号与正确答案的映射，避免重复查找，提升500道题的处理效率
• 遍历Col-A时，先判断当前行是否为字典中存在的题目编号，找到后直接向下遍历4行选项，匹配到正确答案后设置绿色填充
• 处理完一道题的选项后，直接跳过后续4行选项，减少不必要的循环
• 兼容大小写输入（通过UCase统一转换为大写匹配），避免因输入格式不一致导致匹配失败

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