В моем предыдущем ответе была ошибка, которую я пропустил.
В редких случаях за словом следовала одна и та же буква, которой оно заканчивалось, в то время как искалась только эта буква, затем и буква конца, и следующая буква были окрашены.
Вот обновленный ответ:
Сначала мы напишем 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
И результат должен выглядеть так: