VBA для сопоставления слово за словом из ячейки в слово за словом в другой ячейке

Question

Я пытаюсь сопоставить каждое слово в столбце A каждому слову в столбце B. Другими словами, я хочу проверить, присутствуют ли слова столбца A в столбце B. Если да, выделитето же самое в столбце B.

Я пробовал приведенный ниже код, но здесь ищется точное совпадение.

 
Dim xStr As String
    Dim i, Y As Variant
    Dim M, j As Long</p>

count = Range("A4", Range("A4").End(xlDown)).Rows.count

For i = 4 To count + 3
    xStr = Range("B" & i).value
       With Range("G" & i)
        .Font.ColorIndex = 1
        For j = 1 To Len(.Text)
            If Mid(.Text, j, Len(xStr)) = xStr Then .Characters(j, Len(M)).Font.ColorIndex = 3
        Next j
      End With

 Next i

Пример:

Столбец A # BAND AIDWASHPROOF
Колонка B ## Johnson & Johnson Моющийся антисептический лейкопластырь (баночка)

3 слова в колонке A должны быть выделены в колонке B.

Answer 1

Полагаю, вы хотите сравнить слова в B4 с G4, затем B5 с G5 и т. Д. - каждая пара в отдельности.

Если у вас Split содержимое вашей ячейки с пробелом в качестве разделителя, то у вас есть слова в массиве, и вы можете сравнить каждый элемент массива.

Private Sub CompareWords()
    Dim xStr() As String
    Dim i As Long
    Dim x As Long, y As Long

    With ActiveSheet
        For i = 4 To .Cells(.Rows.Count, "B").End(xlUp).Row
            xStr = Split(.Cells(i, "B").Value, " ")
            With .Cells(i, "G")
                .Font.ColorIndex = 1
                For x = LBound(xStr()) To UBound(xStr())
                    For y = 1 To Len(.Text)
                        If Mid(.Text, y, Len(xStr(x))) = xStr(x) Then
                            .Characters(y, Len(xStr(x))).Font.ColorIndex = 3
                        End If
                    Next y
                Next x
            End With
        Next i
    End With
End Sub