¿Cómo poner en negrita todas las palabras específicas en un rango de celdas?

En Excel, la función Buscar y Reemplazar puede ayudarnos a encontrar cualquier texto específico y aplicar negrita u otro formato a todas las celdas. Pero, ¿alguna vez has intentado poner en negrita solo el texto específico dentro de las celdas y no toda la celda como se muestra en la siguiente captura de pantalla?

Poner en negrita todas las palabras específicas en un rango de celdas con código VBA

Poner en negrita todas las palabras específicas en un rango de celdas con código VBA

El siguiente código VBA puede ayudarte a poner en negrita solo el texto específico dentro del contenido de una celda. Por favor, sigue los siguientes pasos:

1. Mantén presionadas las teclas ALT + F11 para abrir la ventana de Microsoft Visual Basic para Aplicaciones.

2. Haz clic en Insertar > Módulo, y pega el siguiente código en la Ventana del Módulo.

Código VBA: Poner en negrita texto específico en un rango de celdas

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. Luego presiona la tecla F5 para ejecutar este código, y aparecerá un cuadro de diálogo que te recordará seleccionar el rango de datos donde deseas aplicar negrita, como se muestra en la siguiente captura de pantalla:

4. Luego haz clic en Aceptar, aparecerá otro cuadro que te pedirá ingresar el texto específico que deseas poner en negrita solo en las celdas, como se muestra en la siguiente captura de pantalla:

5. Después de ingresar el texto, haz clic en el botón Aceptar, y todo el texto que especificaste se habrá puesto en negrita en el rango seleccionado, como se muestra en la siguiente captura de pantalla: