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

问题描述

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

I have the following code which allows me to change one word to a different color. Is there a way to change multiple words to different colors so I don't have to set up the macro for 100 different words, and then run the macro 100 different times?

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

For example - this is the code when searching for word 'dog'. Can I also add in 'cat' somehow?

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

推荐答案

使用一系列宠物。在获取到每个单独的单元格之后，循环遍历数组，测试每个值并根据需要调整文本颜色。

Work with an array of pets. After getting to each individual cell, cycle through the array, testing each value and adjusting the text color as necessary.

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

这篇关于根据单词列表将单词颜色更改为红色的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！