如何编写行敏感VBA宏，循环高亮同行G列中匹配的C列字符串？

需求：实现VBA宏，查找每行C列的字符串，若在同行G列的文本中找到该字符串，就将G列中对应的匹配字符串标红。目前代码是逐行重复编写的，需要改成循环处理到最后一行的高效写法。

现有逐行重复的代码示例（仅展示第2、3行逻辑） #

Sub Macro1()

Set ThisWB = ActiveWorkbook
Set ThisWS = ActiveSheet

Col1 = 3
Col2 = 7
Col1_rowSTART = 2
Col2_rowSTART = 2
Col1_rowEND = 2
Col2_rowEND = 2

For i = Col1_rowSTART To Col1_rowEND
    strTest = CStr(ThisWS.Cells(i, Col1))
    strLen = Len(strTest)
    For y = Col2_rowSTART To Col2_rowEND
        If InStr(CStr(ThisWS.Cells(y, Col2)), strTest) > 0 Then
            ThisWS.Cells(y, Col2).Characters(InStr(ThisWS.Cells(y, Col2), strTest), strLen).Font.Color = vbRed
            
        End If
    Next y
Next i

Set ThisWB = ActiveWorkbook
Set ThisWS = ActiveSheet
Col1 = 3 
Col2 = 7 
Col1_rowSTART = 3
Col2_rowSTART = 3
Col1_rowEND = 3
Col2_rowEND = 3
    
For i = Col1_rowSTART To Col1_rowEND
    strTest = CStr(ThisWS.Cells(i, Col1))
    strLen = Len(strTest)
    For y = Col2_rowSTART To Col2_rowEND
        If InStr(CStr(ThisWS.Cells(y, Col2)), strTest) > 0 Then
            ThisWS.Cells(y, Col2).Characters(InStr(ThisWS.Cells(y, Col2), strTest), strLen).Font.Color = vbRed
                
        End If
    Next y
Next i

End Sub

尝试失败的情况 #

• 曾尝试一种写法（未保存）：会将G列中匹配到的所有C列字符串标红，不满足行敏感要求。
• 另一种尝试代码（Macro3）：会将G列整行文本标红，而非仅匹配的目标字符串：

Sub Macro3()

Dim aRow As Range
For Each aRow In Selection.Rows.EntireRow

Set ThisWB = ActiveWorkbook
Set ThisWS = ActiveSheet
Col1 = 3 'Words Col C
Col2 = 7 'Comments Col G

Col1_rowSTART = 2
Col1_rowEND = 500

For i = Col1_rowSTART To Col1_rowEND
    strTest = CStr(ThisWS.Cells(i, Col1))
    strLen = Len(strTest)

For y = Col1_rowSTART To Col1_rowEND
        If InStr(CStr(ThisWS.Cells(y, Col2)), strTest) > 0 Then
            ThisWS.Cells(y, Col2).Characters(InStr(ThisWS.Cells(y, Col2), strTest), strLen).Font.Color = vbRed
                
        End If
    Next y
Next i

Next aRow

End Sub

正确的循环实现代码 #

Sub HighlightMatchingText()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim searchText As String
    Dim matchPos As Integer
    Dim textLen As Integer
    
    ' 指定当前操作的工作表
    Set ws = ActiveSheet
    
    ' 自动获取C列最后一行有数据的行号，无需硬编码
    lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
    
    ' 从第2行（假设第1行是表头）循环到最后一行
    For i = 2 To lastRow
        ' 获取当前行C列的字符串
        searchText = CStr(ws.Cells(i, "C").Value)
        textLen = Len(searchText)
        
        ' 跳过空单元格，避免无效匹配
        If textLen > 0 Then
            ' 在当前行G列中查找匹配字符串，vbTextCompare表示忽略大小写（可根据需求移除）
            matchPos = InStr(1, CStr(ws.Cells(i, "G").Value), searchText, vbTextCompare)
            
            ' 如果找到匹配位置
            If matchPos > 0 Then
                ' 将G列中匹配的字符标红
                ws.Cells(i, "G").Characters(matchPos, textLen).Font.Color = vbRed
            End If
        End If
    Next i
End Sub

关键说明 #

• 自动获取最后一行：通过ws.Cells(ws.Rows.Count, "C").End(xlUp).Row动态获取C列数据的最后一行，比硬编码行数更灵活，适配数据增减。
• 严格行敏感：用同一个循环变量i对应C列和G列的同行单元格，确保只匹配当前行的内容，不会跨行匹配。
• 空值处理：增加If textLen > 0判断，跳过C列的空单元格，避免空字符串导致的无意义匹配。
• 精准标红：通过Characters(matchPos, textLen)定位匹配的字符区间，只标红目标字符串而非整行文本。

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