Koşullu Biçimlendirme

[steppe]

A Sütunundaki Ankara geçen hücreleri Bold (kalın) yapmak istiyorum.Büyük-küçük harf duyarlı olmasın,kısaltılmışı yazınca da (Örn.ANK veya Ank gibi) bold yapılabilsin.Yardımlarınız için şimdiden teşekkürler.

 

[Ömer]

Merhaba,

Bu şekilde deneyin.

Sub KalınYazı()
 
    Dim c As Range, Adr As Variant, a As Integer, aranan As String
 
    Application.ScreenUpdating = False
 
    aranan = "Ankara"
 
    With Range("A:A")
        .Font.Bold = False
        Set c = .Find(Left(aranan, 3))
        If Not c Is Nothing Then
          Adr = c.Address
          Do
            On Error Resume Next
            a = Evaluate("=FIND(""Ank"",PROPER(""" & Cells(c.Row, "A") & """))")
            If a > 0 Then
                Cells(c.Row, "A").Characters(a, Len(aranan)).Font.Bold = True
            End If
          Set c = .FindNext(c)
          Loop While Not c Is Nothing And c.Address <> Adr
        End If
    End With
 
    Application.ScreenUpdating = True
 
End Sub

.

 

[steppe]

Ömer Hocam,
Yardımların için teşekkür ederim.Yalnız Ankara kelimesi değilde tüm hücreyi bold yapamaz mıyız?

 

[Ömer]

Bu şekilde deneyin.

Sub KalınYazı()
 
    Dim c As Range, Adr As Variant, aranan As String
 
    Application.ScreenUpdating = False
 
    aranan = "Ankara"
 
    With Range("A:A")
        .Font.Bold = False
        Set c = .Find(Left(aranan, 3))
        If Not c Is Nothing Then
            Adr = c.Address
            Do
                Cells(c.Row, "A").Font.Bold = True
            Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> Adr
        End If
    End With
 
    Application.ScreenUpdating = True
 
End Sub

.

 

[steppe]

Ömer Hocam,
Çok teşekkür ederim,tam istediğim gibi olmuş.