Сравните 2 ячейки и выделите соответствующие слова

Question

У меня есть предложение в столбце A, и у меня есть предложение в столбце B. Я хочу, чтобы соответствовать A1 и B1 и красный цвет для слов, которые соответствуют. Например:

A1: Lenovo T450 with 5 GB RAM Intel i5 CPU 500 GB HDD 14" HD screen, weight 3.5 pounds (90)

B1: Len 5 GB h i5 CPU 500 GB HDD 14" HD 3.5 (90)

И я хочу закрасить красным следующие слова в ячейке А1 - 5 GB i5 CPU 500 GB HDD 14" HD 3.5 (90)

Answer 1

В моем предыдущем ответе была ошибка, которую я пропустил. В редких случаях за словом следовала одна и та же буква, которой оно заканчивалось, в то время как искалась только эта буква, затем и буква конца, и следующая буква были окрашены.

Вот обновленный ответ:

Сначала мы напишем sub и некоторые переменные, которые нам понадобятся:

Sub sameStringRed()

Dim i As Integer, j As Integer, intStart As Integer
Dim rngA As Range, rngB As Range
Dim strDelimit As String: strDelimit = " "

Переменная strDelimit определяет, что отделяет слова друг от друга, и может быть заменена на что-то вроде «,», если это необходимо.

Затем мы приступаем к настройке наших диапазонов по мере необходимости.

For Each rngA In Selection.Rows
    Set rngB = rngA.Offset(0, 1)
    strA = Split(rngA.Text, strDelimit)
    strB = Split(rngB.Text, strDelimit)
 Next

Каждая выбранная строка в столбце будет rngA а каждая строка в столбце рядом с ним будет rngB . Затем создается массив с помощью функции Split , с одной записью для каждого слова в каждой ячейке.

Далее мы продолжим сравнение двух массивов:

For j = LBound(strA) To UBound(strA)
    For i = LBound(strB) To UBound(strB)
        If UCase(strA(j)) = UCase(strB(i)) Then
            intStart = InStr(1, strDelimit + UCase(rngA.Value) + strDelimit, strDelimit + UCase(strB(i)) + strDelimit)

        End If
    Next i
Next j

Это будет принимать каждую запись в каждом массиве и сравнивать их друг с другом. И если они идентичны, переменная intStart будет установлена в положение первого совпадающего слова в ячейке rngA выбранной ячейки. Теперь с strDelimit, добавленным с обеих сторон, убедитесь, что это не другое слово, заканчивающееся или начинающееся с того же, что ищется.

Теперь нам нужно что-то сделать с этой информацией, поэтому в предыдущем операторе if мы можем использовать следующее:

While intStart > 0
    rngA.Characters(Start:=intStart, Length:=Len(strB(i))).Font.ColorIndex = 3
    intStart = InStr(intStart + 1, strDelimit + UCase(rngA.Value) + strDelimit, strDelimit + UCase(strB(i)) + strDelimit)
Wend

Здесь мы просто устанавливаем цвет символов в выбранной ячейке на индекс 3, который является красным.
Затем мы добавляем +1 к intStart и снова запускаем проверку, чтобы увидеть, есть ли у нас еще подходящие слова.

Небольшая проблема сейчас в том, что

For Each rngA In Selection.Rows
    Set rngB = rngA.Offset(0, 1)

выдаст ошибку, если выбрано несколько столбцов.

Чтобы справиться с этим, мы можем добавить простую обработку ошибок с использованием On Error GoTo Error

Окончательный код будет выглядеть следующим образом: Редактировать Пропущенный с учетом регистра и заново добавить функцию управления.

Sub sameStringRed()

Dim i As Integer, j As Integer, intStart As Integer
Dim rngA As Range, rngB As Range
Dim strDelimit As String: strDelimit = " "

For Each rngA In Selection.Rows
    Set rngB = rngA.Offset(0, 1)
    On Error GoTo Error
    strA = Split(rngA.Text, strDelimit)
    strB = Split(rngB.Text, strDelimit)
    For j = LBound(strA) To UBound(strA)
        For i = LBound(strB) To UBound(strB)
            If UCase(strA(j)) = UCase(strB(i)) Then
                intStart = InStr(1, strDelimit + UCase(rngA.Value) + strDelimit, strDelimit + UCase(strB(i)) + strDelimit)
                While intStart > 0
                    rngA.Characters(Start:=intStart, Length:=Len(strB(i))).Font.ColorIndex = 3
                    intStart = InStr(intStart + 1, strDelimit + UCase(rngA.Value) + strDelimit, strDelimit + UCase(strB(i)) + strDelimit)

                Wend
            End If
        Next i
    Next j
Next
Exit Sub
Error:
MsgBox "Please do not select multiple columns"
End Sub

И результат должен выглядеть так: