Excel VBA对比两列单元格文本差异标红 解决不同长度文本误标问题

现存问题 #

当前使用的逐位固定位置对比代码存在明确缺陷：

1. 文本长度不一致时字符位置错位，差异词之后的所有相同内容会被误标为红色，效果如下：
   
2. 代码逻辑硬编码绑定F1、G1单元格，不支持F、G整列逐行批量对比
3. 缺少样式重置步骤，重复运行会残留历史标红样式

原代码如下：

Sub Compare()

For i = 1 To Len(ActiveSheet.Range("F1").Value)

If (ActiveSheet.Range("F1").Characters(i, 1).Text <> ActiveSheet.Range("G1").Characters(i, 1).Text) Then

    ActiveSheet.Range("F1").Characters(i, 1).Font.Color = RGB(255, 0, 0)
    
End If

Next i

End Sub

优化后可直接运行的代码 #

Sub CompareAndMarkDiff()
    Dim ws As Worksheet
    Dim lastRow As Long, rowIdx As Long
    Dim fContent As String, gContent As String
    Dim fCursor As Long, gCursor As Long
    
    Set ws = ActiveSheet
    ' 自动识别F列最后一个有内容的行号
    lastRow = ws.Cells(ws.Rows.Count, "F").End(xlUp).Row
    
    ' 逐行遍历对比
    For rowIdx = 1 To lastRow
        fContent = ws.Range("F" & rowIdx).Value
        gContent = ws.Range("G" & rowIdx).Value
        
        ' 空行直接跳过
        If Len(Trim(fContent)) > 0 And Len(Trim(gContent)) > 0 Then
            ' 先重置当前单元格字体为黑色，清除历史标红
            ws.Range("F" & rowIdx).Font.Color = vbBlack
            fCursor = 1
            gCursor = 1
            
            ' 双指针对比，适配长度不一致场景，避免位置错位
            Do While fCursor <= Len(fContent)
                ' 当前位置字符匹配时，双指针同步后移
                If gCursor <= Len(gContent) And Mid(fContent, fCursor, 1) = Mid(gContent, gCursor, 1) Then
                    gCursor = gCursor + 1
                Else
                    ' 字符不匹配，标红
                    ws.Range("F" & rowIdx).Characters(fCursor, 1).Font.Color = RGB(255, 0, 0)
                End If
                fCursor = fCursor + 1
            Loop
        End If
    Next rowIdx
End Sub

使用说明 #

• 待标记差异的文本放在F列，作为对比基准的文本放在G列
• 打开VBA编辑器快捷键为Alt+F11，插入模块粘贴代码后直接运行即可
• 代码自动覆盖F列所有非空行，无需手动指定行范围
• 双指针动态匹配逻辑不会因为两侧文本长度不同出现后续内容错位误标的问题

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