Modificando o código existente para destacar várias palavras diferentes de uma só vez, em vez de destacar uma única string

Question

Eu tenho o seguinte código que solicita uma string e, em seguida, destaca todas as ocorrências dela nas células selecionadas.

Como posso modificá-lo para solicitar e destacar várias palavras diferentes em uma operação?

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

    

Answer 1

Este código modificado permitirá que você insira várias palavras separadas por espaço, e todas elas serão destacadas:

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

Ele usa a função Split() para separar as palavras inseridas em uma matriz e, em seguida, usa um loop extra para percorrer todas as palavras de cada célula na seleção.

Observe que o código faz distinção entre maiúsculas e minúsculas. Pode ser modificado para se tornar insensível a maiúsculas, alterando esta afirmação

xArr = Split(xCell.Value, varWord)

para isso

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

    

Answer 2

Esta versão modificada do código do VBA destacará palavras específicas no intervalo selecionado.

Crie um botão de comando & insira este código.

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

Como funciona:

• Clique no botão de comando.
• Responda a primeira caixa de entrada selecionando o intervalo de dados & termine com Ok.
• Insira as palavras separadas por vírgula (por exemplo, Abc, Xyz) enquanto segunda caixa de entrada aparece e termina com Ok.

Nota, Lembre-se de que é sensível a maiúsculas e minúsculas, por isso escreva Palavras exatamente como escritas em Células.