根据单词列表将单词颜色更改为红色

我有下面的代码，它允许我改变一个字到不同的颜色。 有没有办法将多个单词换成不同的颜色，所以我不必为100个不同的单词设置macros，然后运行macros100次不同的时间？

例如 – 这是search单词“狗”时的代码。 我也可以join“猫”吗？

Sub test() Dim changeRange As Range, oneCell As Range Dim testStr As String, seekstr As String Dim startPosition As String seekstr = "dog": Rem adjust Set changeRange = ThisWorkbook.Sheets("Sheet1").Range("A2:B21"): Rem adjust For Each oneCell In changeRange.Cells testStr = CStr(oneCell.Value) testStr = LCase(testStr): seekstr = LCase(seekstr): Rem For Case insensitive oneCell.Font.ColorIndex = xlAutomatic: Rem remove all colors startPosition = 1 Do While 0 < InStr(startPosition, " " & testStr & " ", " " & seekstr & " ", 1) startPosition = InStr(startPosition, " " & testStr & " ", " " & seekstr & " ") + 1 oneCell.Characters(startPosition - 1, Len(seekstr)).Font.ColorIndex = 3 Loop Next oneCell End Sub 

Answer 1

与一系列宠物一起工作。 在到达每个单元格之后，循环遍历数组，testing每个值并根据需要调整文本颜色。

 Sub test() Dim changeRange As Range, oneCell As Range Dim testStr As String, seekstr As String Dim startPosition As String Dim v As Long, vPETs As Variant vPETs = Array("dog", "cat", "hamster") Set changeRange = ThisWorkbook.Sheets("Sheet1").Range("A2:B21"): Rem adjust For Each oneCell In changeRange.Cells testStr = CStr(oneCell.Value) testStr = LCase(testStr): seekstr = LCase(seekstr): Rem For Case insensitive oneCell.Font.ColorIndex = xlAutomatic: Rem remove all colors For v = LBound(vPETs) To UBound(vPETs) seekstr = vPETs(v) startPosition = 1 Do While 0 < InStr(startPosition, " " & testStr & " ", " " & seekstr & " ", 1) startPosition = InStr(startPosition, " " & testStr & " ", " " & seekstr & " ") + 1 oneCell.Characters(startPosition - 1, Len(seekstr)).Font.ColorIndex = 3 Loop Next v Next oneCell End Sub