Metin içindeki rakamı renklendirme

[y_tekeli]

Eğer(ara(2;1/(lst!$e$5:$e$292=$c22)/(lst!$f$5:$f$292=$g$4);lst!$ı$5:$ı$292)<=0;"ödeme yaptı";eğer(ara(2;1/(lst!$e$5:$e$292=$c22)/(lst!$f$5:$f$292=$g$4);lst!$ı$5:$ı$292)>0; ara(2;1/(lst!$e$5:$e$292=$c22)/(lst!$f$5:$f$292=$g$4);lst!$ı$5:$ı$292) &" tl ödemesi var"))

şeklinde bir formülüm var formül sonucu örneğin
''500 tl ödemesi var'' olsun buradaki ''500 tl'' kısmını renkli yazsın istiyorum. Birçok örneğe baktım ama bulamadım.
şimdiden emeğinize sağlık

 

[Korhan Ayhan]

Formülle gelen veriyi renklendiremezsiniz.

 

[y_tekeli]

Saygıdeğer hocam bunu macro vasıtasıyla yapmamız mümkün mü peki

 

[Korhan Ayhan]

Örnek dosyanızı eklerseniz yardımcı olabilirim.

 

[monelogg]

Merhaba, ben soruyla uğraştım fakat yapamadım, cevabı da merak ediyorum,
A1 hücresinde ''500 tl ödemesi var'' yazıyorsa bunu nasıl renklendirebiliriz?

 

[ÖmerBey]

Eğer A1 hücresinde metin olarak ''500 tl ödemesi var'' yazıyorsa "500 tl" kısmını renklendirmek için aşağıdaki kodlar kullanılabilir.

Sub sayi_renklendir()
a = [A1]
For i = 1 To Len(a)
If IsNumeric(Mid(a, i, 1)) Then [A1].Characters(i, 1).Font.ColorIndex = 3
If Mid(a, i, 4) = " tl " Then [A1].Characters(i, 3).Font.ColorIndex = 3
Next
End Sub

 

[monelogg]

Teşekkürler Sn. mucit77.

 

[tahsinanarat]

Saadece a1 hücresi değilde a sutundakilerin hepsi

Sn. mucit77; A1 hücresi değilde A sutunu için olursa kodda nasıl bir değişiklik olurdu

Eğer A1 hücresinde metin olarak ''500 tl ödemesi var'' yazıyorsa "500 tl" kısmını renklendirmek için aşağıdaki kodlar kullanılabilir.

Sub sayi_renklendir()
a = [A1]
For i = 1 To Len(a)
If IsNumeric(Mid(a, i, 1)) Then [A1].Characters(i, 1).Font.ColorIndex = 3
If Mid(a, i, 4) = " tl " Then [A1].Characters(i, 3).Font.ColorIndex = 3
Next
End Sub

 

[ExcelF1]

Sayın mucit77'nin kodlarını şu şekilde revize ederek deneyiniz.

Sub sayi_renklendir()
For b = 1 To [A65536].End(xlUp).Row
a = Cells(b, 1)
For i = 1 To Len(a)
If IsNumeric(Mid(a, i, 1)) Then Cells(b, 1).Characters(i, 1).Font.ColorIndex = 3
If Mid(a, i, 4) = " tl " Then Cells(b, 1).Characters(i, 3).Font.ColorIndex = 3
Next
Next
End Sub

 

[Korhan Ayhan]

Alternatif;

Sub Renklendir()
    Range("A:A").Font.ColorIndex = 0
    Range("A:A").Font.Bold = False
    Range("A:A").Font.Size = 10
    
    For X = 1 To Cells(Rows.Count, 1).End(3).Row
        Say = InStr(1, Cells(X, 1), "TL")
        If Say > 0 Then
            Cells(X, 1).Characters(1, Say + 1).Font.ColorIndex = 3
            Cells(X, 1).Characters(1, Say + 1).Font.Bold = True
            Cells(X, 1).Characters(1, Say + 1).Font.Size = 14
        End If
    Next

    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[tahsinanarat]

Sn. Korhan hocam sizin kodlar TL den öncesinin tamamını renklendiriyor, Bilgilerinize.

 

[Korhan Ayhan]

Evet.

Çünkü sorulan sorudaki ifade "500 TL ÖDEMESİ VAR" şeklindeydi. Doğal olarak önerdiğim kodlar doğru sonuç verir.

 

[tahsinanarat]

Sn. Korhan hocam siz haklısınız, peki Tahsin ANARAT'ın 500 TL ödemesi var olsaydı, saadece 500 rakamını renkli yapılabilirmiydi, saygılar.

 

[Korhan Ayhan]

Aşağıdaki kodu deneyiniz.

Sub Renklendir()
    Range("A:A").Font.ColorIndex = 0
    Range("A:A").Font.Bold = False
    Range("A:A").Font.Size = 10
    
    For X = 1 To Cells(Rows.Count, 1).End(3).Row
        Data = Split(Cells(X, 1), " ")
        Ilk = 0
        For Y = 0 To UBound(Data)
            If IsNumeric(Data(Y)) Then
                Cells(X, 1).Characters(Ilk, Len(Data(Y)) + 4).Font.ColorIndex = 3
                Cells(X, 1).Characters(Ilk, Len(Data(Y)) + 4).Font.Bold = True
                Cells(X, 1).Characters(Ilk, Len(Data(Y)) + 4).Font.Size = 14
                Ilk = Ilk + Len(Data(Y)) + 1
            Else
                Ilk = Ilk + Len(Data(Y)) + 1
            End If
        Next
    Next

    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[monelogg]

Merhaba, ben dün şöyle bir kod yazmıştım,

Sub renklendir()
    ReDim dizi(1000, 1)
    
    For i = 1 To Len(Cells(1, 1))
        dizi(i - 1, 0) = Mid(Cells(1, 1), i, 1)
    Next
    For j = LBound(dizi) To UBound(dizi)
        If IsNumeric(dizi(j, 0)) Then
            dizi(j, 0).Characters(Start:=1, Length:=1).Font.ColorIndex = 3
            Cells(1, 3) = Cells(1, 3) & dizi(j, 0)
            Else
            Cells(1, 3) = Cells(1, 3) & dizi(j, 0)
        End If
    Next

End Sub

Kod, burada yazılanlara göre kötü fakat anlayamadığım bir nokta var.

Cells(1,1) 1x1 boyutlu bir dizi değil midir? Öyleyse neden dizi(j,0) yazdığımda "Object required" hatası veriyor?

 

[ÖmerBey]

Cells(1,1) demek 1. satırdaki birinci hücre demek... O da = A1

 

[monelogg]

Merhaba, haklısınız aslında 1x1 boyutlu bir dizinin özelliklerini taşımıyor mu diye soracaktım fakat galiba ki taşımıyor. Halbuki formül yazarken oluyordu.
Mesala KAÇINCI(C1;A1:A2;0) ile KAÇINCI(C1;{"A"\"B"};0) sonuç veriyor ama demek ki makroda olmuyor.

Cevabınız için teşekkürler Sn. mucit77.

 

[tahsinanarat]

Sn. Korhan hocam cevabınız için teşekkürler, harika oldu, elinize sağlık.

 

[onder_09]

Merhaba kolay gelsin elimdeki excel dosyasındaki borç listesi sekmesindeki *** TL kısmının kırmızı ve kalın olmasını istiyorum. Metin tek sütun olması zorunda çünkü sms sistemindeki şablon o şekilde. Şimdiden teşekkürler yardımlarınız için.

İndir onder 2019 2020AYLIK DÖKÜM

Dosyayı indir onder 2019 2020AYLIK DÖKÜM

dosya.co

 

[Korhan Ayhan]

Deneyiniz.

Sub Renklendir()
    Range("B:B").Font.ColorIndex = 0
    Range("B:B").Font.Bold = False
    Range("B:B").Font.Size = 11
    
    For X = 2 To Cells(Rows.Count, 2).End(3).Row
        If Cells(X, 1) = "" Then
            Cells(X, 2).Font.Bold = True
        Else
            Data = Split(Cells(X, 2), " ")
            Ilk = 0
            For Y = 0 To UBound(Data)
                If IsNumeric(Data(Y)) Then
                    Cells(X, 2).Characters(Ilk, Len(Data(Y)) + 4).Font.ColorIndex = 3
                    Cells(X, 2).Characters(Ilk, Len(Data(Y)) + 4).Font.Bold = True
                    Cells(X, 2).Characters(Ilk, Len(Data(Y)) + 4).Font.Size = 11
                    Ilk = Ilk + Len(Data(Y)) + 1
                Else
                    Ilk = Ilk + Len(Data(Y)) + 1
                End If
            Next
        End If
    Next

    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub