• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Metin içindeki rakamı renklendirme

Y

y_tekeli

Katılım
9 Aralık 2006
Mesajlar
134
Excel Vers. ve Dili
microsoft office professional plus 2010 TR
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
 
Formülle gelen veriyi renklendiremezsiniz.
 
Saygıdeğer hocam bunu macro vasıtasıyla yapmamız mümkün mü peki
 
Örnek dosyanızı eklerseniz yardımcı olabilirim.
 
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?
 
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.
Kod: 
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
 
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
mucit77' Alıntı:
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.
Kod: 
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
Genişletmek için tıkla ...
 
Sayın mucit77'nin kodlarını şu şekilde revize ederek deneyiniz.

Kod: 
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
 
Alternatif;

Kod: 
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
 
Sn. Korhan hocam sizin kodlar TL den öncesinin tamamını renklendiriyor, Bilgilerinize.
 
Evet.

Çünkü sorulan sorudaki ifade "500 TL ÖDEMESİ VAR" şeklindeydi. Doğal olarak önerdiğim kodlar doğru sonuç verir.
 
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.
 
Aşağıdaki kodu deneyiniz.

Kod: 
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
 
Merhaba, ben dün şöyle bir kod yazmıştım,
Kod: 
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?
 
Cells(1,1) demek 1. satırdaki birinci hücre demek... O da = A1
 
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.
 
Sn. Korhan hocam cevabınız için teşekkürler, harika oldu, elinize sağlık.
 
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
 
Deneyiniz.

C++: 
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
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst