Excel VBA代码来比较两列中的文本字符串，并突出显示某些文本字符串不是整个单元格？

Question

我需要做一个vba代码来比较两列中的文本，并突出显示第二列中的匹配文本。我开始编写代码，下面是我到目前为止的内容。它在第一行工作正常，如何修改代码以将其应用于整个表格，而不仅仅是第一行。我是VBA新手，任何帮助都会很棒。

Sub Test1() 
    Dim strString$, x& 
    Dim rngCell As Range 

    strString = Range("G2").Value 
    Application.ScreenUpdating = False 
    For Each rngCell In Range("S2", Range("S" & Rows.Count).End(xlUp)) 
     With rngCell 
      .Font.ColorIndex = 1 
      For x = 1 To Len(.Text) - Len(strString) Step 1 
       If Mid(.Text, x, Len(strString)) = strString Then .Characters(x, Len(strString)).Font.ColorIndex = 5 
      Next x 
     End With 
    Next rngCell 
    Application.ScreenUpdating = True 
End Sub 

Answer 1

如果您代码正常的第一行（我没有测试过，所以才会只相信你是正确的），那么下面，我认为，要改变什么：

Sub Test1() 
    Dim strString$, x& 
    Dim rngCell As Range 

    Application.ScreenUpdating = False 
    For Each rngCell In Range("S2", Range("S" & Rows.Count).End(xlUp)) 
     With rngCell 
      .Font.ColorIndex = 1 
      strString = Cells(rngCell.Row, "G").Value 
      For x = 1 To Len(.Text) - Len(strString) Step 1 
       If Mid(.Text, x, Len(strString)) = strString Then .Characters(x, Len(strString)).Font.ColorIndex = 5 
      Next x 
     End With 
    Next rngCell 
    Application.ScreenUpdating = True 
End Sub 

即移动的strString计算的循环内，并且基于它正在处理的行的列G中的值。

Answer 2

我只是给别人这个答案非常similar question ...

Sub ColorMatchingString() 
    Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets(1) 
    Dim strTest As Collection: Set strTest = New Collection 
    Dim udRange As Range: Set udRange = ws.Range("AC2:AC311") 'Define Search Ranges 
    Dim myCell, myMatch, myString, i 
    Dim temp() As String, tempLength As Integer, stringLength As Integer 
    Dim startLength as Integer 

    For Each myMatch In udRange 'Build the collection with Search Range Values 
     strTest.Add myMatch.Value 
    Next myMatch 

    For Each myCell In ws.Range("A2:AB1125") 'Loop through each cell in range 
     temp() = Split(myCell.Text, ", ") 'define our temp array as "," delimited 
     startLength = 0 
     stringLength = 0 

     For i = 0 To UBound(temp) 'Loop through each item in temp array 
      tempLength = Len(temp(i)) 
      stringLength = stringLength + tempLength + 2 

      For Each myString In strTest 
    'Below compares the temp array value to the collection value. If matched, color red. 
       If StrComp(temp(i), myString, vbTextCompare) = 0 Then 
        startLength = stringLength - tempLength - 1 
        myCell.Characters(startLength, tempLength).Font.Color = vbRed 
       End If 
      Next myString 
     Next i 
     Erase temp 'Always clear your array when it's defined in a loop 
    Next myCell 
End Sub