修改现有代码,一次突出显示多个不同的单词,而不是突出显示单个字符串

修改现有代码,一次突出显示多个不同的单词,而不是突出显示单个字符串

我有以下代码,它提示输入字符串,然后在选定的单元格中突出显示它的所有实例。

我如何修改它以便在一次操作中提示并突出显示多个不同的单词?

Sub HighlightStrings()
    Dim xHStr As String, xStrTmp As String
    Dim xHStrLen As Long, xCount As Long, I As Long
    Dim xCell As Range
    Dim xArr
    On Error Resume Next
    xHStr = Application.InputBox("What is the string to highlight:", "KuTools For Excel", , , , , , 2)
    If TypeName(xHStr) <> "String" Then Exit Sub
    Application.ScreenUpdating = False
        xHStrLen = Len(xHStr)
        For Each xCell In Selection
            xArr = Split(xCell.Value, xHStr)
            xCount = UBound(xArr)
            If xCount > 0 Then
                xStrTmp = ""
                For I = 0 To xCount - 1
                    xStrTmp = xStrTmp & xArr(I)
                    xCell.Characters(Len(xStrTmp) + 1, xHStrLen).Font.ColorIndex = 3
                    xStrTmp = xStrTmp & xHStr
                Next
            End If
        Next
    Application.ScreenUpdating = True
End Sub

答案1

此修改后的代码将允许您输入多个以空格分隔的单词,并且所有单词都将突出显示:

Option Explicit
'v0.1.1
Sub HighlightStrings()
    Dim xHStr As String, xStrTmp As String
    Dim xHStrLen As Long, xCount As Long, I As Long
    Dim xCell As Range
    Dim xArr
    On Error Resume Next
    xHStr = Application.InputBox("What are the words to highlight:", "Word Higlighter")
    If TypeName(xHStr) <> "String" Then Exit Sub
    Application.ScreenUpdating = False
        For Each xCell In Selection
            Dim varWord As Variant
            For Each varWord In Split(xHStr, Space$(1))
                xHStrLen = Len(varWord)
                xArr = Split(xCell.Value, varWord)
                xCount = UBound(xArr)
                If xCount > 0 Then
                    xStrTmp = ""
                    For I = 0 To xCount - 1
                        xStrTmp = xStrTmp & xArr(I)
                        xCell.Characters(Len(xStrTmp) + 1, xHStrLen).Font.ColorIndex = 3
                        xStrTmp = xStrTmp & varWord
                    Next
                End If
            Next varWord
        Next xCell
    Application.ScreenUpdating = True
End Sub

它使用Split()函数将输入的单词分离到数组中,然后使用额外的循环循环遍历选择中每个单元格的所有单词。

请注意,代码区分大小写。可以通过更改此语句将其修改为不区分大小写

xArr = Split(xCell.Value, varWord)

对此

xArr = Split(UCase$(xCell.Value), UCase$(varWord))

答案2

此修改版本的 VBA 代码将突出显示选定范围内的特定单词。

创建一个命令按钮并输入此代码。

Private Sub CommandButton1_Click()

Dim strSearch As String
Dim UserRange As Range
Dim arySearch As Variant
Dim searchRng As Range
Dim cel As Range
Dim i As Long, ii As Long

Set UserRange = Application.InputBox(Prompt:="Please Select Range", Title:="Range Select", Type:=8)

strSearch = InputBox("Please Enter Text To Highlight As A Comma Delimited List (Abc, Xyz) it's Case Sensative :", "Highlight Text")

If strSearch = "" Then Exit Sub
arySearch = Split(strSearch, ",")

For Each cel In UserRange

With cel

For ii = LBound(arySearch) To UBound(arySearch)

i = InStr(cel.Value, arySearch(ii))
If i > 0 Then

.Characters(i, Len(arySearch(ii))).Font.ColorIndex = 3
End If
Next ii
End With
Next cel
End Sub

怎么运行的:

  • 单击命令按钮。
  • 通过选择数据范围来响应第一个输入框并单击确定完成。
  • 在出现第二个输入框时输入以逗号分隔的单词(例如 Abc、Xyz),然后单击确定。

笔记, 请记住,它区分大小写,因此请按照单元格中所写的完全一致地写入单词。

相关内容