问与答112：如何查找一列中的内容是否在另一列中并将找到的字符添加颜色？

excelperfect

引言：本文整理自vbaexpress.com论坛，有兴趣的朋友可以研阅。

Q：我在列D的单元格中存放着一些数据，每个单元格中的多个数据使用换行分开，列E是对列D中数据的相应描述，我需要在列E的单元格中查找是否存在列D中的数据，并将找到的数据标上颜色，如下图1所示。

图1

如何使用VBA代码实现？

A：实现上图1中所示效果的VBA代码如下：

Sub ColorText()

    Dim ws As Worksheet

    Dim rDiseases As Range

    Dim rCell As Range

    Dim avDiseases As Variant

    Dim iDisease As Long

    Dim iMatchStart As Long

    Dim iColor As Long

    Set ws = Worksheets('Task')

    Set rDiseases = Range(ws.Cells(2, 4),ws.Cells(ws.Rows.Count, 4).End(xlUp))

    For Each rCell In rDiseases.Cells

        iColor = vbRed

        avDiseases = Split(rCell.Value, vbLf)

        For iDisease = LBound(avDiseases) To UBound(avDiseases)

            iMatchStart = 1

            Do While iMatchStart > 0

                iMatchStart =InStr(iMatchStart, rCell.Offset(0, 1).Value, avDiseases(iDisease),vbTextCompare)

                If iMatchStart > 0 Then

                    rCell.Offset(0,1).Characters(iMatchStart, Len(avDiseases(iDisease))).Font.Color = iColor

                    iColor = IIf(iColor =vbRed, vbGreen, vbRed)

                    iMatchStart = iMatchStart +Len(avDiseases(iDisease))

                End If

            Loop

        Next iDisease

    Next rCell

End Sub

代码中使用Split函数以回车符来拆分单元格中的数据并存放到数组中，然后遍历该数组，在列E对应的单元格中使用InStr函数来查找是否出现了该数组中的值，如果出现则对该值添加颜色。

Bug：通常是交替添加红色和绿色，但是当句子中存在多个匹配或者局部匹配时，颜色会打乱。