Hoe alle specifieke woorden in een bereik van cellen vet te maken?

In Excel kan de functie Zoeken en Vervangen ons helpen om elke specifieke tekst te vinden en vet of andere opmaak toe te passen op de hele cellen. Maar heb je ooit geprobeerd alleen de specifieke tekst in de cellen vet te maken, niet de hele cel zoals in de onderstaande schermafbeelding te zien is:

Alle specifieke woorden in een bereik van cellen vet maken met VBA-code

Alle specifieke woorden in een bereik van cellen vet maken met VBA-code

De volgende VBA-code kan u helpen om alleen de specifieke tekst in de inhoud van een cel vet te maken. Volg hiervoor de volgende stappen:

1. Houd de toetsen ALT + F11 ingedrukt om het venster Microsoft Visual Basic for Applications te openen.

2. Klik op Invoegen > Module en plak de volgende code in het Modulevenster.

VBA-code: Specifieke tekst vet maken in een bereik van cellen

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. Druk vervolgens op de F5-toets om deze code uit te voeren, en er verschijnt een pop-upvenster dat u eraan herinnert het gegevensbereik te selecteren dat u wilt vetmaken, zie screenshot:

4. Klik vervolgens op OK, en er verschijnt een ander venster waarin u wordt gevraagd de specifieke tekst in te voeren die u alleen in de cellen wilt vetmaken, zie screenshot:

5. Nadat u de tekst hebt ingevoerd, klikt u op de knop OK, en alle tekst die u heeft opgegeven is vetgemaakt in het geselecteerde bereik, zie screenshot: