Question

这是我搜索和突出显示代码的成品，它工作正常，但我希望我的代码有更多颜色。我希望之后弹出另一个输入框 SearchString = InputBox(Prompt:="What word would you like to highlight?") 询问你希望单词突出显示的颜色。

Sub Sample()
Dim oRange As Range, aCell As Range, bCell As Range
Dim ws As Worksheet
Dim ExitLoop As Boolean
Dim SearchString As String, Foundat As String
Dim iCount() As String
Dim outws As Worksheet

Set ws = Worksheets("detail_report")

Set oRange = ws.Cells


SearchString = InputBox(Prompt:="What word would you like to highlight?")

Set aCell = oRange.Find(What:=SearchString, LookIn:=xlValues, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)

If Not aCell Is Nothing Then
    Set bCell = aCell
    Foundat = aCell.Address
    Do While ExitLoop = False
        Set aCell = oRange.FindNext(After:=aCell)

        If Not aCell Is Nothing Then
            If aCell.Address = bCell.Address Then Exit Do
            Foundat = Foundat & ", " & aCell.Address
        Else
            ExitLoop = True
        End If
    Loop

 iCount = Split(Foundat, ", ")

Set outws = Worksheets("output")
    outws.Range("A1").Value = "Word"
    outws.Range("B1").Value = "Count"
    outws.Range("A2").Value = SearchString
    outws.Range("B2").Value = UBound(iCount) + 1

   End If

 Dim cellRange As Range
 Set cellRange = oRange.Find(What:=SearchString, LookIn:=xlValues, _
                LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)

 If Not cellRange Is Nothing Then


Foundat = cellRange.Address

Do

    Dim textStart As Integer
    textStart = 1

    Do

        textStart = InStr(textStart, LCase(cellRange.Value), LCase(SearchString))
        If textStart <> 0 Then
            cellRange.Characters(textStart, Len(SearchString)).Font.Color = RGB(255, 255, 0)
            textStart = textStart + 1
        End If


    Loop Until textStart = 0


    Set cellRange = oRange.FindNext(After:=cellRange)

Loop Until cellRange Is Nothing Or cellRange.Address = Foundat
Else
    MsgBox SearchString & " not Found"


End If

End Sub

Answer 1

如果我是你，我会创建一个带下拉列表的自定义控件，除了你的问题“你要强调哪个词”。而不是使用两个默认的InputBox提示。

然而，一种快速而简单的方法是设置另一个InputBox并询问颜色。然后使用'switch case'语句检查有效输入。如果用户输入了不受支持的值，或者只是使用默认值，则可以重新提示用户。

'I like to use UCASE to standarize the case of the user's input
ColorString = UCASE(InputBox("What color would you like to use?"))

'Set Default Color
color = RGB(0,255,255)

select case ColorString
    case "RED"
         color = RGB(255,0,0)
    case "GREEN"
         color = RGB(0,255,0)
    case "BLUE"
         color = RGB(0,0,255)
end select

'现在，在您之前的算法中找到匹配项时设置单元格

cellRange.Interior.Color = color

为vba excel添加更多颜色

1 个答案: