Como colocar em negrito todas as palavras específicas em um intervalo de células?

No Excel, a função Localizar e Substituir pode nos ajudar a encontrar qualquer texto específico e aplicar negrito ou outra formatação para as células inteiras. Mas, você já tentou colocar em negrito apenas o texto específico nas células, e não a célula inteira, como mostrado na captura de tela abaixo:

Colocar em negrito todas as palavras específicas em um intervalo de células com código VBA

Colocar em negrito todas as palavras específicas em um intervalo de células com código VBA

O seguinte código VBA pode ajudá-lo a colocar em negrito apenas o texto específico no conteúdo de uma célula; por favor, faça o seguinte:

1. Pressione e segure as teclas ALT + F11 para abrir a janela do Microsoft Visual Basic for Applications.

2. Clique em Inserir > Módulo e cole o seguinte código na Janela do Módulo.

Código VBA: Colocar em negrito texto específico em um intervalo de células

Sub FindAndBold()
'Updateby Extendoffice 20160711
    Dim xFind As String
    Dim xCell As Range
    Dim xTxtRg As Range
    Dim xCount As Long
    Dim xLen As Integer
    Dim xStart As Integer
    Dim xRg As Range
    Dim xTxt As String
    On Error Resume Next
    If ActiveWindow.RangeSelection.Count > 1 Then
      xTxt = ActiveWindow.RangeSelection.AddressLocal
    Else
      xTxt = ActiveSheet.UsedRange.AddressLocal
    End If
    Set xRg = Application.InputBox("Please select data range:", "Kutools for Excel", xTxt, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    On Error Resume Next
    Set xTxtRg = Application.Intersect(xRg.SpecialCells(xlCellTypeConstants, xlTextValues), xRg)
    If xTxtRg Is Nothing Then
        MsgBox "There are no cells with text"
        Exit Sub
    End If
    xFind = Trim(Application.InputBox("What do you want to BOLD?", "Kutools for Excel", , , , , , 2))
    If xFind = "" Then
        MsgBox "No text was listed", vbInformation, "Kutools for Excel"
        Exit Sub
    End If
    xLen = Len(xFind)
    For Each xCell In xTxtRg
        xStart = InStr(xCell.Value, xFind)
        Do While xStart > 0
            xCell.Characters(xStart, xLen).Font.Bold = True
            xCount = xCount + 1
            xStart = InStr(xStart + xLen, xCell.Value, xFind)
        Loop
    Next
    If xCount > 0 Then
        MsgBox "number of " & CStr(xCount) & " text be bolded!", vbInformation, "Kutools for Excel"
    Else
        MsgBox "Not find the specific text!", vbInformation, "Kutools for Excel"
    End If
End Sub

3. Em seguida, pressione a tecla F5 para executar este código, e uma caixa de aviso será exibida para lembrá-lo de selecionar o intervalo de dados que deseja colocar em negrito, veja a captura de tela:

4. Depois clique em OK, outra caixa aparecerá para lembrá-lo de inserir o texto específico que deseja colocar em negrito apenas nas células, veja a captura de tela:

5. Após inserir o texto, clique no botão OK, e todo o texto especificado terá sido colocado em negrito no intervalo selecionado, veja a captura de tela: