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

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

2 个答案: