Hücre içeriğinde ki metni siyah bold yazma

[jeoferkan]

Merhabalar
Ben bir hücredeki uzun bir cümle içerisindeki bir kısmı kalın bold yazdırmak istiyorum. Yani "Merhabalar sayın site yöneticileri" cümlesinde ki "site" kelimesini siyah/bold yazdırmak istiyorum. koşullu biçimlendirmeyi denedim cümlenin tamamına uyguluyor.

 

[Erdem Akdemir]

Merhaba bu işlemi makro ile yapabilirsiniz.

Aşağıdaki kodu inceleyin.

Sub jeo()

a = InputBox("metin giriniz", "metin")

b = Range("a1")

c = VBA.InStr(1, b, a)

d = Len(a)


Range("a1").Characters(c, d).Font.Bold = True

End Sub

 

[suleyman112233]

F2'ye basın, site yazısını tarayın ( mouse'un sol tuşuna basarak)
Yukarıdan araç çubuğundan "K" harfine ( yazıyı koyu hale getirme) basın.

Dilerseniz bu yöntemle aynı hücre içindeki yazının bir bölümünü renklendirebilirsiniz de.

 

[jeoferkan]

Sayın Kuvari bu kodları tüm çalışma kitabına nasıl uygulayabiliriz.

 

[Emir Hüseyin Çoban]

. . .

Sub KOD()
    Dim Alan As Range
    a = InputBox("metin giriniz", "metin")
    s = ActiveSheet.Name
    
    Application.ScreenUpdating = False
    For i = 1 To Sheets.Count
        Sheets(i).Select
        For Each Alan In ActiveSheet.UsedRange
            If Alan.Value Like "*" & a & "*" Then
                b = Alan.Value
                c = VBA.InStr(1, b, a)
                d = Len(a)
                Alan.Characters(c, d).Font.Bold = True
            End If
        Next Alan
    Next i
    Sheets(s).Select
    
    Application.ScreenUpdating = True
    MsgBox "B i t t i "
End Sub

. . .

 

[tahsinanarat]

Aşağıdaki kodu kullanın

Sub FindAndBold()
    Dim sFind As String
    Dim rCell As Range
    Dim rng As Range
    Dim lCount As Long
    Dim iLen As Integer
    Dim iFind As Integer
    Dim iStart As Integer

    On Error Resume Next
    Set rng = ActiveSheet.UsedRange. _
      SpecialCells(xlCellTypeConstants, xlTextValues)
    On Error GoTo ErrHandler
    If rng Is Nothing Then
        MsgBox "There are no cells with text"
        GoTo ExitHandler
    End If

    sFind = InputBox( _
      Prompt:="What do you want to BOLD?", _
      Title:="Text to Bold")
    If sFind = "" Then
        MsgBox "No text was listed"
        GoTo ExitHandler
    End If

    iLen = Len(sFind)
    lCount = 0

    For Each rCell In rng
        With rCell
            iFind = InStr(.Value, sFind)
            Do While iFind > 0
                .Characters(iFind, iLen).Font.Bold = True
                lCount = lCount + 1
                iStart = iFind + iLen
                iFind = InStr(iStart, .Value, sFind)
            Loop
        End With
    Next

    If lCount = 0 Then
        MsgBox "Aradığınız " & _
          vbCrLf & "' " & sFind & " '" & _
          vbCrLf & "adlı kelime olmadı, Başka kelime girin."
    ElseIf lCount = 1 Then
        MsgBox "One occurrence of" & _
          vbCrLf & "' " & sFind & " '" & _
          vbCrLf & "was made bold."
    Else
        MsgBox lCount & " adet bulundu" & _
          vbCrLf & "' " & sFind & " '" & _
          vbCrLf & "bold yapıldı."
    End If

ExitHandler:
    Set rCell = Nothing
    Set rng = Nothing
    Exit Sub

ErrHandler:
    MsgBox Err.Description
    Resume ExitHandler
End Sub

 

[Hacı Bayram ÖZKAN]

Bir hücrede iki tane aynı metin varsa birincisi koyu yapıyor, eğer ikincisinde koyu yapması için nasıl bir degisiklik yapılır. Teşekkürler

 

[tahsinanarat]

Sn. tarzanhaci şimdi test ettim, kaç adet olduğunu söyleyip hepsini bold yapıyor. Bilginiz olsun.