从B列在A列在Excel

Question

查找字符串的常见我想强调从coloumn的B Coloumn A. 注值：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

使用字典方法，并强调如果该键在字典中找到

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柱细胞和“加粗”（更好的词？）的字符串发现（见代码注释）

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