从excel中的列A的列B中findstring的共同点

我想突出显示Coloumn A中coloumn B的值。注意：列B包含A列中的文本子集。

例如：

Answer 1

最好的我可以想出使用VBA来改变字体的颜色。

 Dim row As Integer Dim str As String Dim index As Integer Dim rng As Range lastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).row Set rng = Range("A1") For row = 1 To lastRow str = rng.Offset(0, 1).Value index = InStr(rng.Value, str) If index > 0 Then rng.Characters(index).Font.Color = vbGreen Set rng = rng.Offset(1, 0) Next row Set rng = Nothing 

Answer 2

使用字典方法，并突出显示在字典中find的关键字

 Option Explicit Sub HiglightColumn() Dim MyWorkbook As Workbook Dim MyWorksheet As Worksheet Set MyWorkbook = Workbooks(ActiveWorkbook.Name) Set MyWorksheet = MyWorkbook.Sheets("WorksheetName") Dim LastRow As Long Dim CurrentRow As Long Dim myList As Object Set myList = CreateObject("Scripting.Dictionary") For CurrentRow = 2 To MyWorksheet.Cells(MyWorksheet.Rows.Count, "B").End(xlUp).row myList.Item(Right(MyWorksheet.Range("B" & CurrentRow), 6)) = "new" Next For CurrentRow = 2 To MyWorksheet.Cells(MyWorksheet.Rows.Count, "A").End(xlUp).row If myList.Exists(Right(MyWorksheet.Range("A" & CurrentRow), 6)) Then With MyWorksheet.Range("A" & CurrentRow).Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 5287936 .TintAndShade = 0 .PatternTintAndShade = 0 End With Else With MyWorksheet.Range("A" & CurrentRow).Interior .Pattern = xlNone .TintAndShade = 0 .PatternTintAndShade = 0 End With End If Next CurrentRow End Sub 

Answer 3

此过程突出显示A列中A单元格和“粗体” （更好的单词？）find的string（请参阅代码中的注释）

 Option Explicit Sub FindMatchAndMark_Interior() Dim WshTrg As Worksheet Dim lLastRowA As Long, lLastRowB As Long Dim lRowA As Long, lRowB As Long Dim sCllB As String Dim bPos As Byte Rem Set Target Worksheet - Update as needed Set WshTrg = ActiveSheet With WshTrg lLastRowA = fLRng_LastRow_byCol_Find(.Columns(1)) lLastRowB = fLRng_LastRow_byCol_Find(.Columns(2)) Rem To Clear Prior Results Range(.Cells(1, 1), .Cells(lLastRowA, 1)).Font.Bold = False With Range(.Cells(1, 1), .Cells(lLastRowA, 1)).Interior .Pattern = xlNone .TintAndShade = 0 .PatternTintAndShade = 0 End With Rem Starting from Row 2 - Update as needed For lRowA = 2 To lLastRowA For lRowB = 2 To lLastRowB sCllB = .Cells(lRowB, 2).Value2 bPos = InStr(.Cells(lRowA, 1).Value2, sCllB) If bPos > 0 Then Rem Fill Interior and Bold String Found With .Cells(lRowA, 1) .Characters(Start:=bPos, Length:=Len(sCllB)).Font.Bold = 1 .Interior.Color = RGB(155, 194, 230) End With Exit For End If: Next: Next: End With End Sub Function fLRng_LastRow_byCol_Find(ColTrg As Range) As Long On Error Resume Next fLRng_LastRow_byCol_Find = ColTrg.Find(What:="*", _ After:=ColTrg.Cells(1), LookIn:=xlFormulas, LookAt:=xlPart, _ SearchOrder:=xlByRows, SearchDirection:=xlPrevious, _ MatchCase:=False, SearchFormat:=False).row On Error GoTo 0 End Function