Sayının veya metnin her karakterini farklı renk yapma

[ozkovlu]

Merhabalar;
A hücresinde bulunan 15265879 sayının iki hane olacak şekilde renklendirmeyi koşullu biçimlendirme veya makro ile nasıl yapılabilir.

Saygılarımla...

 

[Korhan Ayhan]

Merhaba,

Ben artan düzende renk kurgusu yaptım. Dilenirse ve veri uzunluğu sabitse belirlenen renkler kullanılabilir.

Sub İKİLİ_KARAKTER_RENKLENDİR()
    Range("A:A").Font.ColorIndex = False
    
    Son = Cells(Rows.Count, 1).End(3).Row
    
    For X = 1 To Son
        Renk = 3
        For Y = 1 To Len(Cells(X, 1)) Step 2
            Cells(X, 1).Characters(Start:=Y, Length:=2).Font.ColorIndex = Renk
            Renk = Renk + 1
        Next
    Next
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[Tevfik_Kursun]

Sayın Korhan Ayhan Hocam,
Konu benim değil ama, benzer bir çalışmaya benim de ihtiyacım olduğu için inceleme gereği duydum. Araya girdiğim için özür dilerim.
A sütunundaki 2 satıra 2 satır daha ekledim sonuç resimdeki gibi oldu. Sonra eklenen satırlardaki fontlar hep kırmızı oluyor. 4 satır olduğunu biliyor, 2 şer 2 şer değiştireceğini de biliyor, buna rağmen 3. satırdan itibaren font sadece kırmızı geliyor.
Bir yerde benim de gözümden kaçan bir şey mi var?
Saygılarımla

 

[Korhan Ayhan]

Bende denedim. Bir anormallik görünmüyor.

 

[Tevfik_Kursun]

Sayın Korhan Ayhan Hocam,
Eklediğim resme baktınız mı?
A3 ve A4 hücrelerindeki sayılar 8 karakter olmalarına rağmen 2 şer 2 şer farklı renk olmamış. İstenilen 2 şer 2 şer farklı renk olması değil mi? Ben mi yanlış anladım? Bir de bu renkler rastgele gelemez mi, mutlaka aynı renk sırasında mı gelmeli?
Saygılarımla

 

[Korhan Ayhan]

Tevfik Bey,

Deneme yaptığımda eklediğiniz resimdeki 3. ve 4. satırdaki hücrelerde bende 2 şer karakter olarak farklı renkleniyor. Yani tamamen kırmızı olmuyor.

Önerim bilgisayarınızı kapatıp açtıktan sonra kodu tekrar deneyin.

 

[çıtır]

Sayın Korhan Ayhan Hocam,
Sayısal verilerin tamamını kırmızı renk yapıyor.A1 ve A2 hücrelerinde veriler metne dönüştürülmüş.Bende farklı yöntemle yapmaya çalıştım, metinsel (metin ve sayı aynı hücrede veya metin) başarılı oldum.Rakamlarda sorun çıktı.Metne çevirerek sorunu aştım.Tekrar sayıya çevirdiğimde aynı sorunla karşılaştım.

 

[Tevfik_Kursun]

Sayın Korhan Hocam,
Makinemi de kapatıp açtım!
Sayın Çıtır'ın söylediği doğru. Eklediğim resimde de göreceğiniz gibi, B sütunu sayı, A sütunu metin. Bu durumda sonuç doğru. Belki bu halini de kullanabilirim, emin değilim. Ama renkleri de rastgele yapmak mümkün mü?
Saygılarımla

 

[Korhan Ayhan]

Kusura bakmayın. Verilerin sayısal olması gözümden kaçmış.

Bu durumda ilk olarak ilgili sütun metne dönüştürülür ve sonra renklendirme yapılabilir.

Sub İKİLİ_KARAKTER_RENKLENDİR()
    Range("A:A").Font.ColorIndex = False
    Range("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 2), TrailingMinusNumbers:=True
    
    Son = Cells(Rows.Count, 1).End(3).Row
    
    For X = 1 To Son
        For Y = 1 To Len(Cells(X, 1)) Step 2
10          Randomize Timer
            Renk = Int((56 * Rnd) + 1)
            If Renk = 1 Then GoTo 10
            Cells(X, 1).Characters(Start:=Y, Length:=2).Font.ColorIndex = Renk
        Next
    Next
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[Tevfik_Kursun]

Sayın Korhan Hocam,
Rica ederim. Çok şahane olmuş, zihninize ve elinize sağlık. Çok teşekkür ederim.
Yeri gelmişken bir soru daha sorsam umarım ayıp etmiş olmam. Bazı renkler görünmeyecek kadar açık, renk skalasını nasıl kısıtlarım? (Beyaz ve beyaza çok yakın renkleri engellemenin bir yolu var mı?)
Saygılarımla

 

[ozkovlu]

Sayın Korhan Ayhan;
Teşekkürler

 

[Korhan Ayhan]

Hangi renkleri kısıtlamak istiyorsunuz?

 

[Tevfik_Kursun]

Sayın Korhan Hocam,
Beyaz ve beyaza çok yakın renkler
Saygılarımla

 

[Korhan Ayhan]

Deneyiniz.

Harici_Renkler dizisini istediğini gibi değiştirebilirsiniz.

Sub İKİLİ_KARAKTER_RENKLENDİR()
    Range("A:A").Font.ColorIndex = False
    Range("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 2), TrailingMinusNumbers:=True
    
    Son = Cells(Rows.Count, 1).End(3).Row
    Harici_Renkler = Array(2, 19, 20, 34, 35, 36)
    
    For X = 1 To Son
        For Y = 1 To Len(Cells(X, 1)) Step 2
10          Randomize Timer
            Renk = Int((56 * Rnd) + 1)
            For Z = 0 To UBound(Harici_Renkler)
                If Harici_Renkler(Z) = Renk Then GoTo 10
            Next
            Cells(X, 1).Characters(Start:=Y, Length:=2).Font.ColorIndex = Renk
        Next
    Next
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[Tevfik_Kursun]

Sayın Korhan Ayhan Hocam,
Çok teşekkür ederim. Fevkalade değişebilir olmuş.
Saaygılarımla