比较两列并突出显示特定文本

Compare two columns and hightight the specific text

我在 A 和 B 两列中有数据。然后我想比较 A 列中字符串值形式的数据与 B 列中的文本值(这是 SINGLE WORD 文本)。

例如:

                      Column A                               |  Column B
-------------------------------------------------------------|------------
School Assorted Shape Bead Collection, Assorted Size         |  Assorted
School Assorted Shape Bead Collection                        |  Bamboo
Yasutomo Bamboo Brush Holder, 6 in                           |  Holder
Yasutomo Calligraphy Brushes with Bamboo Vase, Set of 10     |  
                                                             |

在 A 列中,'assorted' 是 B 列中的文本,因此在这种情况下我想突出显示该文本。如果没有,则不要突出显示。另一行相同,Bamboo 在两个列中重复。一个和上校。 B.

另外,如果我有一个消息框作为弹出窗口要求选择要比较的单元格范围,那就太好了。

提前致谢。

试试这个

Sub test()
    Dim arrKeyword As Variant, arrItem As Variant
    Dim dataRng As Range, keywordRng As Range, rng As Range, cel As Range

    Set dataRng = Application.InputBox(prompt:="Select Data Range", Title:="Range Select", Type:=8)
    Set keywordRng = Application.InputBox(prompt:="Select Keyword Range", Title:="Range Select", Type:=8)
    If Not dataRng Is Nothing And Not keywordRng Is Nothing Then
        For Each cel In dataRng
            For Each arrItem In keywordRng
                If InStr(cel.Value, arrItem) <> 0 Then
                    Debug.Print arrItem & " Exists"
                    cel.Interior.ColorIndex = 37 'change cel property as needed
                End If
            Next arrItem
        Next cel
    End If
End Sub

对于第一个输入框 select,您的范围在 Column A 中,对于第二个输入框 select,范围在 Column B 中。请参阅图片以供参考。

编辑:


Sub Test()
    Dim dataRng As Range, keywordRng As Range, rng As Range, cel As Range

    Set dataRng = Application.InputBox(prompt:="Select Data Range", Title:="Range Select", Type:=8)
    Set keywordRng = Application.InputBox(prompt:="Select Keyword Range", Title:="Range Select", Type:=8)
    If Not dataRng Is Nothing And Not keywordRng Is Nothing Then
        For Each cel In dataRng
            If InStr(cel.Value, cel.Offset(0, 1).Value) <> 0 Then
                    cel.Interior.ColorIndex = 37 'change cel property as needed
            End If
        Next cel
    End If
End Sub