VBA代码无法为重复值单元格填充颜色问题求助

• 某列数据仅包含「Break」和「Normal」两个值，要求严格遵循Break→Normal→Break的交替模式
• 工作表的行数每周会变动，当出现Break→Normal→Normal的异常序列时，需要将最后一个「Normal」单元格填充红色（例如示例中的C6单元格）
• 预期逻辑：从C2开始，逐行检查当前单元格与下一行单元格的值，若二者相等，则将下一行单元格标红，直至遍历完所有数据行

Sub Compare_Rows()
   
    Range("C2").Select
     
    If (ActiveCell.Value = ActiveCell.Offset(1, 0).Value) Then
        ActiveCell.Offset(1, 0).Interior.ColorIndex = 3
    End If

    Do Until IsEmpty(ActiveCell)
        ActiveCell.Offset(1, 0).Select
    Loop
    
End Sub

• 程序运行时会逐行选中单元格，但仅在一开始检查了C2与C3的关系，后续移动选中单元格的过程中没有执行任何判断逻辑
• 当C5为活动单元格时，C5与C6的值确实相等（符合标红条件），但C6并未被填充红色，其ColorIndex始终显示为-4142（无填充的默认值）

问题根源 #

原代码仅执行了一次判断（仅检查C2和C3），后续的Do循环只是单纯移动选中单元格，没有重复执行「检查相邻单元格→标红」的逻辑，导致后续行的异常情况完全没被处理。

修正后的代码 #

Sub Compare_Rows()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    
    ' 指定操作的工作表，可替换为具体表名如Sheets("数据报表")
    Set ws = ActiveSheet
    ' 获取C列最后一行有数据的行号
    lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
    
    ' 从第2行遍历到倒数第1行，避免越界
    For i = 2 To lastRow - 1
        ' 对比当前行与下一行的值
        If ws.Cells(i, "C").Value = ws.Cells(i + 1, "C").Value Then
            ' 符合条件则标红（ColorIndex=3对应红色）
            ws.Cells(i + 1, "C").Interior.ColorIndex = 3
        Else
            ' 不符合条件则恢复无填充（可选，根据需求调整）
            ws.Cells(i + 1, "C").Interior.ColorIndex = xlColorIndexNone
        End If
    Next i
End Sub

代码优化说明 #

1. 避免使用Select/Activate：直接通过单元格对象操作，提升代码运行效率与稳定性，同时避免因手动选中其他单元格导致的逻辑混乱
2. 动态获取最后一行：自动适配每周变动的行数，无需手动修改代码
3. 循环遍历所有行：逐行检查相邻单元格，确保所有异常情况都被处理

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