在 Excel 中设置文本字符串列表的格式

我正在尝试将 Excel 中出现的单词列表的字体变成红色。到目前为止，我能够找到一个单词，但我需要搜索整个数组。我是 VBA 新手，正在苦苦挣扎。到目前为止，我已经找到了一个解决方案，但它涉及查找单个字符串“F1”：

Sub test4String2color()
Dim strTest As String
Dim strLen As Integer
strTest = Range("F1")
For Each cell In Range("A1:D100")
If InStr(cell, strTest) > 0 Then
cell.Characters(InStr(cell, strTest), strLen).Font.Color = vbRed
End If
Next
End Sub

Edit:

我需要突出显示的单元格包含以逗号分隔格式列出的项目。例如，“苹果 1、苹果 3、香蕉 4、橙子”。要搜索的值列表位于不同的单元格中，“Apple”、“Banana 4”。我只想突出显示“Banana 4”，因为它与逗号分隔值完全匹配。在当前的表述中，“Apple 1”或“Apple 4”的文本将部分突出显示。

Edit 2:

这是我的工作簿中的实际格式：

这是一种通过循环范围、集合和数组来实现您想要的目的的方法。

该代码将查找集合（您选择的匹配单词）和数组（每个单元格中分隔的单词字符串）之间的匹配项。如果找到匹配项，则会设置字符串中的起始字符和结束字符，并对这些值之间的字符进行着色。

Sub ColorMatchingString()
    Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets(1)
    Dim strTest As Collection: Set strTest = New Collection
    Dim udRange As Range: Set udRange = ws.Range("AC2:AC311") 'Define Search Ranges
    Dim myCell, myMatch, myString, i
    Dim temp() As String, tempLength As Integer, stringLength As Integer
    Dim startLength as Integer

    For Each myMatch In udRange 'Build the collection with Search Range Values
        strTest.Add myMatch.Value
    Next myMatch

    For Each myCell In ws.Range("A2:AB1125") 'Loop through each cell in range
        temp() = Split(myCell.Text, ", ") 'define our temp array as "," delimited
        startLength = 0
        stringLength = 0

        For i = 0 To UBound(temp) 'Loop through each item in temp array
            tempLength = Len(temp(i))
            stringLength = stringLength + tempLength + 2

            For Each myString In strTest
  'Below compares the temp array value to the collection value. If matched, color red.
                If StrComp(temp(i), myString, vbTextCompare) = 0 Then 
                    startLength = stringLength - tempLength - 1
                    myCell.Characters(startLength, tempLength).Font.Color = vbRed
                End If
            Next myString
        Next i
        Erase temp 'Always clear your array when it's defined in a loop
    Next myCell
End Sub