Bir hücre aralığındaki tüm belirli kelimeleri kalın yapma

Excel'de, Bul ve Değiştir işlevi bize herhangi bir özel metni bulmamıza ve tüm hücrelere kalın veya başka bir biçimlendirme uygulamamıza yardımcı olabilir. Ancak aşağıdaki ekran görüntüsünde gösterildiği gibi, bir hücredeki yalnızca belirli metni değil tüm hücreyi kalın yapmayı denediniz mi mi?

VBA kodu ile bir hücre aralığındaki tüm belirli kelimeleri kalın yapma

VBA kodu ile bir hücre aralığındaki tüm belirli kelimeleri kalın yapma

Aşağıdaki VBA kodu, bir hücre içeriğinde yalnızca belirli metni kalın yapmanıza yardımcı olabilir, lütfen şu adımları izleyin:

1. Microsoft Visual Basic for Applications penceresini açmak için ALT + F11 tuşlarına basın.

2. Ekle > Modül'e tıklayın ve aşağıdaki kodu Modül Penceresine yapıştırın.

VBA kodu: Bir hücre aralığındaki belirli metni kalın yapma

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. Ardından bu kodu çalıştırmak için F5 tuşuna basın ve seçtiğiniz veri aralığını kalın yapmanızı hatırlatan bir uyarı kutusu açılacaktır, aşağıdaki ekran görüntüsüne bakın:

4. Tamam'a tıklayın, ardından sadece hücrelerde kalın yapmak istediğiniz belirli metni girmenizi hatırlatan başka bir kutu açılacak, aşağıdaki ekran görüntüsüne bakın:

5. Metni girdikten sonra, lütfen Tamam düğmesine tıklayın ve belirttiğiniz tüm metinler seçilen aralıkta kalın olarak biçimlendirilecektir, aşağıdaki ekran görüntüsüne bakın: