比较两个单元格并突出显示匹配的单词

Question

在我之前的回答中，有一个我没注意到的错误。在极少数情况下，一个单词后面跟着与其结尾相同的字母，而只搜索该字母，那么结尾字母和后面的字母都会被着色。

以下是更新后的答案：

首先，我们编写子程序和一些我们需要的变量：

Sub sameStringRed()

Dim i As Integer, j As Integer, intStart As Integer
Dim rngA As Range, rngB As Range
Dim strDelimit As String: strDelimit = " "

strDelimit 变量决定单词之间的分隔符，如果需要，可以将其更改为“，”，例如。

然后我们根据需要继续设置范围。

For Each rngA In Selection.Rows
    Set rngB = rngA.Offset(0, 1)
    strA = Split(rngA.Text, strDelimit)
    strB = Split(rngB.Text, strDelimit)
 Next

每列中选定的每一行将是rngA，其相邻列中的每一行将是rngB。然后使用该函数创建一个数组Split，每个单元格中每个单词对应一个条目。

接下来我们继续比较这两个数组：

For j = LBound(strA) To UBound(strA)
    For i = LBound(strB) To UBound(strB)
        If UCase(strA(j)) = UCase(strB(i)) Then
            intStart = InStr(1, strDelimit + UCase(rngA.Value) + strDelimit, strDelimit + UCase(strB(i)) + strDelimit)

        End If
    Next i
Next j

这将获取每个数组中的每个条目并将它们相互比较。如果它们相同，则变量intStart将设置为单元格中第一个匹配单词的位置rngA 选定的单元格。 现在字符串分隔符在两侧添加以确保它不是以所搜索的相同内容结尾或开头的另一个单词。

现在我们需要利用这些信息做一些实际的事情，因此在前面的if语句中，我们可以使用以下内容：

While intStart > 0
    rngA.Characters(Start:=intStart, Length:=Len(strB(i))).Font.ColorIndex = 3
    intStart = InStr(intStart + 1, strDelimit + UCase(rngA.Value) + strDelimit, strDelimit + UCase(strB(i)) + strDelimit)
Wend

这里我们简单地将所选单元格中的字符颜色设置为索引 3，即红色。
然后我们将 intStart 加 1，并再次运行检查以查看是否还有更多匹配的单词。

现在的一个小问题是

For Each rngA In Selection.Rows
    Set rngB = rngA.Offset(0, 1)

如果选择多列，将会引发错误。

为了解决这个问题，我们可以添加一个简单的错误处理，使用On Error GoTo Error

最终代码将如下所示：编辑错过了区分大小写并重新添加了控制功能。

Sub sameStringRed()

Dim i As Integer, j As Integer, intStart As Integer
Dim rngA As Range, rngB As Range
Dim strDelimit As String: strDelimit = " "

For Each rngA In Selection.Rows
    Set rngB = rngA.Offset(0, 1)
    On Error GoTo Error
    strA = Split(rngA.Text, strDelimit)
    strB = Split(rngB.Text, strDelimit)
    For j = LBound(strA) To UBound(strA)
        For i = LBound(strB) To UBound(strB)
            If UCase(strA(j)) = UCase(strB(i)) Then
                intStart = InStr(1, strDelimit + UCase(rngA.Value) + strDelimit, strDelimit + UCase(strB(i)) + strDelimit)
                While intStart > 0
                    rngA.Characters(Start:=intStart, Length:=Len(strB(i))).Font.ColorIndex = 3
                    intStart = InStr(intStart + 1, strDelimit + UCase(rngA.Value) + strDelimit, strDelimit + UCase(strB(i)) + strDelimit)

                Wend
            End If
        Next i
    Next j
Next
Exit Sub
Error:
MsgBox "Please do not select multiple columns"
End Sub

结果应该是这样的：

Answer 1