Поиск диапазона слов из абзаца

Question

У меня есть список слов. Я хочу отметить это слово в абзаце, если он совпадает. если слово соответствует, то хотите изменить цвет.

Я пытаюсь этот код:

Sub HighlightStrings()
Application.ScreenUpdating = False
Dim rng As Range
Dim InputRang As Range
Dim cFnd As String
Dim xTmp As String
Dim x As Long
Dim celValue As String
Dim m As Long
Dim y As Long
Dim xFNum As Integer
Dim xArrFnd As Variant
Dim xStr As String

celValue = Range("A1").Value
cFnd = celValue
If Len(cFnd) < 1 Then Exit Sub
xArrFnd = Split(cFnd, ";")
For Each rng In Selection
With rng
For xFNum = 0 To UBound(xArrFnd)
xStr = xArrFnd(xFNum)
y = Len(xStr)
m = UBound(Split(rng.Value, xStr))
If m > 0 Then
xTmp = ""
For x = 0 To m - 1
xTmp = xTmp & Split(rng.Value, xStr)(x)
.Characters(Start:=Len(xTmp) + 1, Length:=y).Font.ColorIndex = 3
.Characters(Start:=Len(xTmp) + 1, Length:=y).Font.Bold = True
xTmp = xTmp & xStr
Next
End If
Next xFNum
End With
Next rng
Application.ScreenUpdating = True
End Sub

Но этот код становится одно слово. мне нужен диапазон слова с точкой с запятой отдельно. например, "привет; абзац; полужирный; слова"

Answer 1

Я сам решаю свою проблему. Нужно добавить этот код:

Dim arr
    arr = Join(Application.Transpose(Range("A1:A4").Value), ";")

Полный код:

Sub HighlightStrings()
Application.ScreenUpdating = False
Dim rng As Range
Dim InputRang As Range
Dim cFnd As String
Dim xTmp As String
Dim x As Long
Dim m As Long
Dim y As Long
Dim xFNum As Integer
Dim xArrFnd As Variant
Dim xStr As String
Dim arr

arr = Join(Application.Transpose(Range("A1:A4").Value), ";")
cFnd = arr

If Len(cFnd) < 1 Then Exit Sub
xArrFnd = Split(cFnd, ";")
    For Each rng In Selection
        With rng
            For xFNum = 0 To UBound(xArrFnd)
            xStr = xArrFnd(xFNum)
            y = Len(xStr)
            m = UBound(Split(rng.Value, xStr))
                If m > 0 Then
                xTmp = ""
                    For x = 0 To m - 1
                    xTmp = xTmp & Split(rng.Value, xStr)(x)
                    .Characters(Start:=Len(xTmp) + 1, Length:=y).Font.ColorIndex = 3
                    .Characters(Start:=Len(xTmp) + 1, Length:=y).Font.Bold = True
                    xTmp = xTmp & xStr
                    Next
                End If
            Next xFNum
        End With
    Next rng
Application.ScreenUpdating = True
End Sub