Excel宏开发需求：跨工作表对比值为正确选项单元格着色

需求说明 #

需要实现的功能：

• 读取Sheet2中A列的题目编号与B列的对应正确选项（如1对应B、2对应D）
• 在Sheet1中定位到对应编号下的正确选项单元格，将其填充为绿色
• Sheet1数据格式：每个编号下方依次列出A、B、C、D四个选项，C列为选项标识（A/B/C/D）

VBA代码实现 #

打开Excel按Alt + F11打开VBA编辑器，插入模块后粘贴以下代码：

Sub MarkCorrectAnswers()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim lastRow2 As Long, lastRow1 As Long
    Dim i As Long, j As Long
    Dim questionNum As String, correctOpt As String
    
    ' 指定操作的工作表
    Set ws1 = ThisWorkbook.Sheets("Sheet1")
    Set ws2 = ThisWorkbook.Sheets("Sheet2")
    
    ' 获取Sheet2数据的最后一行
    lastRow2 = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row
    
    ' 遍历Sheet2的每一组编号与正确选项
    For i = 2 To lastRow2 ' 假设第一行是表头，从第二行开始读取数据
        questionNum = ws2.Cells(i, "A").Value
        correctOpt = ws2.Cells(i, "B").Value
        
        ' 获取Sheet1数据的最后一行
        lastRow1 = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row
        
        ' 在Sheet1中定位目标编号并匹配正确选项
        For j = 2 To lastRow1 ' 假设Sheet1第一行为表头
            If ws1.Cells(j, "A").Value = questionNum Then
                ' 向下遍历该编号下的所有选项（默认4行）
                Dim optRow As Long
                For optRow = j To j + 3
                    If ws1.Cells(optRow, "C").Value = correctOpt Then
                        ' 设置单元格填充色为绿色
                        ws1.Cells(optRow, "C").Interior.ColorIndex = 4
                        Exit For ' 找到目标后退出内层循环
                    End If
                Next optRow
                Exit For ' 找到对应编号后退出中层循环
            End If
        Next j
    Next i
    
    MsgBox "正确选项标记完成！", vbInformation
End Sub

代码关键点说明 #

• 工作表定位：通过Set语句明确指定操作的工作表，避免切换工作表时出现逻辑混乱
• 动态遍历范围：用End(xlUp)获取数据的最后一行，避免遍历空行浪费资源
• 匹配逻辑：先定位Sheet1中对应编号的起始行，再向下遍历选项行，匹配到正确选项后立即设置填充色并退出循环
• 颜色设置：ColorIndex = 4对应Excel标准绿色，也可替换为RGB(0, 176, 80)使用更精准的绿色色调

注意事项 #

• 确保Sheet1和Sheet2的第一行为表头，实际数据从第二行开始
• 如果Sheet1中每个编号下的选项行数不是固定4行，需调整j + 3的数值为实际选项行数减1
• 运行宏前建议备份数据，避免因数据格式不符导致误操作

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