Question

我有以下代码，允许我将一个单词更改为不同的颜色。有没有办法将多个单词更改为不同的颜色，所以我不必为100个不同的单词设置宏，然后运行宏100个不同的时间？

例如 - 这是搜索单词'dog'时的代码。我还能以某种方式添加'猫'吗？

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

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

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

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

1 个答案: