Koşullu Biçimlendirme

[speech_free]

Merhaba,

A2 ile H43 aralığındaki hücrelerde veriler var. Bunlar hem yazı hem de metrekare şeklinde. Örnek:

Deneme Verisi-Kişi A-15.25 M2-Eryaman

Bu aralıktaki M2 değerlerini kalın yapma şansımız var mı? M2 dedim çünkü bu sayı değişken. Kimi zaman 15.25 kimi zaman 2.65 kimi zaman da 165.42

Çok teşekkür ederim.

 

[Ömer]

Merhaba,

Makro ile yapabilirsiniz.

Sub Duzenle()

    Dim a As Range, b As Byte
    
    For Each a In Range("A2:H43")
        If a <> "" Then
            a.Font.Bold = False
            b = InStr(1, a, "M2")
            If b > 0 Then
                a.Characters(b, 2).Font.Bold = True
            End If
        End If
    Next a
  
End Sub

.

 

[speech_free]

Ömer Bey, teşekkürler hızlı dönüş için. Kodu çalıştırdım fakat M2 kısmını kalın yaptı. Ben ise M2'nin önündeki sayı ile beraber yapmasını istiyordum. Bu mümkün mü?

 

[Ömer]

Veri yapınızı görmem için, 5-6 farklı veri girişi yaparak küçük bir örnek dosya eklemenizi rica ederim.

.

 

[speech_free]

Dosyayı link ile paylaştım.

http://s5.dosya.tc/server4/zxnv6t/TEST.rar.html

 

[Ömer]

Detaylı deneme yapmadım.

Sub Duzenle()

    Dim a As Range, b As Byte, c As String, d, e
    
    For Each a In Range("A2:H43")
        If a <> "" Then
            a.Font.Bold = False
            b = InStr(1, a, "M2")
            c = Left(a, b)
            d = Split(c, " ")
            e = d(UBound(d) - 1)
            If b > 0 Then
                a.Characters(b - Len(e) - 1, Len(e) + 3).Font.Bold = True
            End If
        End If
    Next a
  
End Sub

.

 

[speech_free]

Harika oldu. Gene süpersiniz Ömer bey. Eline sağlık.

 

[speech_free]

Ömer Bey, gene ben. )

Bu test dosyasında hep M2 vardı. Eğer ki hücrenin içinde M2 yoksa

e = d(UBound(d) - 1)

satırında hata veriyor. M2 olmayan hücrelerde bu kodu çalıştırmama gibi bir seçenek olabilir mi?

 

[Korhan Ayhan]

Deneyiniz.

Sub TEST()
    Dim Veri As Range, Bul As Integer, X As Integer, Karakter As String
    
    For Each Veri In Range("A2:H43")
        If Veri.Value <> "" Then
            Veri.Font.Bold = False
            Bul = InStr(1, Veri.Value, " M2")
            If Bul > 0 Then
                For X = Bul To 1 Step -1
                    Karakter = Mid(Veri.Value, X, 1)
                    Select Case Karakter
                        Case " ", 0 To 9, ".", ","
                        Case Else
                            Exit For
                    End Select
                Next
                Veri.Characters(X + 1, Bul - X + 2).Font.Bold = True
            End If
        End If
    Next
End Sub

 

[Ömer]

Ömer Bey, gene ben. )

Bu test dosyasında hep M2 vardı. Eğer ki hücrenin içinde M2 yoksa

e = d(UBound(d) - 1)

satırında hata veriyor. M2 olmayan hücrelerde bu kodu çalıştırmama gibi bir seçenek olabilir mi?

Korhan Bey'in yanıtını da kullanabilirsiniz.

Aynı düzende kodlardaki,

If b > 0 Then satırını eski yerinden silip;

b = InStr(1, a, "M2") satırından sonra yazarsanız da istediğiniz olur.

Sub Duzenle()

    Dim a As Range, b As Byte, c As String, d, e
    
    For Each a In Range("A2:H43")
        If a <> "" Then
            a.Font.Bold = False
            b = InStr(1, a, "M2")
            [COLOR="Blue"]If b > 0 Then[/COLOR]
                c = Left(a, b)
                d = Split(c, " ")
                e = d(UBound(d) - 1)
                 a.Characters(b - Len(e) - 1, Len(e) + 3).Font.Bold = True
            End If
        End If
    Next a
  
End Sub

Gibi.

.

 

[speech_free]

Korhan Bey ve Ömer Bey,

Teşekkür ediyorum ikinize de. Ömer Bey, sizin cevaptan önce Korhan Bey'in yazmış olduğu kod ile işimi hallettim. Çıkan ihtiyaçlar doğrultusunda da kodu kendime göre uyarladım ve ektsra satır ekledim End Sub'dan önce.

For Each Koyu In Range("C2:H2")
    Koyu.Font.Bold = True
    Next
    For Each Koyu2 In Range("C9:H9")
    Koyu2.Font.Bold = True
    Next

Anlaşılacağı üzere C2:H2 ve C9:H9 satırlarındaki bold özelliğini kaybetmek istemediğim için bunu yaptım. Bunu bir döngüye koyup her 6 satırda bir bu kodu çalıştırma şansım var mı?

 

[Ömer]

Aşağıdaki kod yeterli olur.

Sub Bold()
    
    Dim i As Byte
    
    For i = 2 To 43 '2 ile 43.satır arası işlem yapar
        If (i - 2) Mod 6 = 0 Then
        'Mod 6 değeri 6 satırda bir işlemi ifade eder.
            Cells(i, "C").Resize(1, 6).Font.Bold = True
            'Resize(1, 6) değeri C ile H arasındaki sütun sayısını ifade eder.
        End If
    Next i
    
End Sub

.

 

[speech_free]

Ömer Bey, teşekkür ediyorum. Güzel bir takvim oldu sayenizde. İkinizin de emeğine sağlık.