在Excel中格式化文本string列表
我正试图把字体变成红色，以便在excel中出现一个单词列表。 到目前为止，我能find一个单词，但我需要search一个完整的数组。 我是VBA的新手，正在挣扎。 到目前为止，我已经能够find这个解决scheme，但它处理查找单个string“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 编辑：
我需要突出显示的单元格以逗号分隔的格式列出的项目。 例如，“苹果1，苹果3，香蕉4，橙色”。 要search的值列表在不同的单元格中，“Apple”，“Banana 4”。 我只想突出显示“香蕉4”，因为这是与逗号分隔的值完全匹配。 在目前的表述中，“苹果1”或“苹果4”的文字将会部分突出显示。
编辑2：
这是我的工作簿中的实际格式：
这是一种通过遍历范围，集合和数组来实现你所期望的方法。
代码会在集合（您select的匹配词）和数组（每个单元格中分隔的词的string）之间find匹配项。 如果find匹配，则设置string中的起始和结束字符，并将这些值之间的字符着色。
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
在保持你原来的代码，你可以添加另一个For each cell in Range （和其他一些事情）的For each cell in Range ：
Sub test4String2color() Dim wb As Workbook Dim ws As Worksheet Dim strLen As Integer Dim i As Long Dim tst As Range Set wb = ActiveWorkbook Set ws = wb.ActiveSheet Dim keyWordRng As Range Dim dataRng As Range Set keyWordRng = ws.Range("F1:F2") Set dataRng = ws.Range("A1:A5") For Each tst In keyWordRng Debug.Print "Searching for: " & tst For Each cell In dataRng If tst.Value = cell.Value Then cell.Characters(InStr(cell, tst), strLen).Font.Color = vbRed ElseIf InStr(1, cell.Value, ",") > 0 Then getWordsInCell cell, tst.Value End If Next cell Next tst End Sub Sub getWordsInCell(ByVal cel As Range, keyword As String) Dim words() As String Dim keywordS As Integer, keywordE As Integer words = Split(cel.Value, ",") Dim i As Long For i = LBound(words) To UBound(words) Debug.Print "Found multiple words - one of them is: " & words(i) If Trim(words(i)) = keyword Then keywordS = ActiveWorkbook.WorksheetFunction.Search(keyword, cel, 1) keywordE = ActiveWorkbook.WorksheetFunction.Search(",", cel, keywordS) cel.Characters(keywordS, (keywordE - keywordS)).Font.Color = vbRed End If Next i End Sub
请注意我添加到范围（ keyWordRng和dataRng ），您将需要调整您的工作表。 这应该（手指交叉）工作！
