Bir hücredeki birden fazla uyarının her birini koşullu biçimlendirme ile farklı renk yazdırma

[teyadih]

Kolay gelsin arkadaşlar. Bir hücredeki birden fazla uyarının her birini koşullu biçimlendirme ile farklı renk yazdıracak formüle ihtiyacım var. Örnek dosyayı gönderiyorum.
Birde P5 de yan yana arlarına / koyularak yazılan formülü / koymak yerine her uyarıyı satır başı yapacak şekilde düzenleyebilir misiniz? Teşekkür ederim

 

[YUSUF44]

ikinci isteğiniz için formüldeki " / " yerine Damga(10) ifadesini kullanırsanız ayrı satırlara yazar.

İlk isteğiniz makrosuz olur mu bilmiyorum. Makrolu nasıl olur onu da bilmiyorum maalesef

 

[teyadih]

Sayın YUSUF44 benim isteğimde cevap yazdığınız https://www.excel.web.tr/threads/kosullu-bicimlendirme.181681/ konusundaki gibi koşullu biçimlendirmedeki yeni kurulda formül kullanmak suretiyle renklendirme, tek fark benimki aynı satırda farklı renk olacak. Duruma göre uyarıların hepside olabilir bir veya ikisi de. Bu nedenle dikkat çekmesi için ayrı renk olsun istiyorum. Her biri için farklı formül yazılmak suretiyle
Satırda var yazarsa kırmızı
Sonraki Aya Ait Rapor yazarsa mavi
Yatış Ayrı Girilmiş Mi? yazarsa mor
Varsa Daha Önce Kullandığı Bu Yıla Ait Raporları Ekleyiniz yazarsa yeşil
Rapor 40 günü GEÇEMEZ, son raporun heyete çevrilmesi yazarsa turuncu
olsun şeklinde formülle yazdırabilir miyiz yukarıdaki tarih benzeri

 

[YUSUF44]

Önceki mesajımda da belirttiğim gibi koşullu biçimlendirme ile hücre içinin farklı biçimlendirilmesinin mümkün olmadığını düşünüyorum. Hiç görmedim duymadım bilmiyorum maalesef.

 

[teyadih]

Teşekkür ederim ilginize

 

[YUSUF44]

Sorunun çözümü için epey uğraştım ama aklımdaki çözümü uygulayamadım maalesef.

Önce makro aracılığıyla hücre içindeki veriyi inceleyip istediğiniz renklendirmeyi yapmak istedim ama parça parça renklendirmeyi yapamadım.

Sonra dosyadaki mevcut dizi formülünü önce makroyla hücreye ekleyip, sonra formül sonucunu değere çevirip, hücredeki değeri renklendirmek istedim ama maalesef dizi formülün hücreye makro ile ekleyemedim.

Makro kaydet yoluyla aldığım dizi formülü şu şekilde:

    Selection.FormulaArray = _
        "=IF(R[1]C[-14]="""","""",IFERROR(IF(ROW()-2-MATCH(R[1]C[-14]&R[1]C[-10],R3C2:R[1]C[-14]&R3C6:R[1]C[-10],0)=0,"""",MATCH(R[1]C[-14]&R[1]C[-10],R1C2:R[1]C[-14]&R1C6:R[1]C[-10],0)& "".Satırda var""),""""))&CHAR(10)&IF(R1C16-R[1]C[-10]<1,""Sonraki Aya Ait Rapor"","""")&CHAR(10)&IF(R[1]C[-7]>0,""Yatış Ayrı Girilmiş Mi?"","""")&CHAR(10)&IF(R[1]C[4]=""x"","""",IFERROR(IF(R" & _
        "OW()=SMALL(IF(R4C10:R4151C10>=R1C16,IF(MIN(IF(R4C2:R4151C2=R[1]C2,R4C10:R4151C10))=R4C10:R4151C10,ROW(R4C1:R4151C1))),ROW(R1C1)),""Varsa Daha Önce Kullandığı Bu Yıla Ait Raporları Ekleyiniz"",""""),""""))&CHAR(10)&IF(AND(R[1]C[-5]+0=1000,R[1]C[-1]>40),""Rapor 40 günü GEÇEMEZ, son raporun heyete çevrilmesi"",IF(AND(R[1]C[-5]+0=2000,R[1]C[-1]>40),""Rapor 40 günü GEÇEM" & _
        "EZ, son raporun heyete çevrilmesi"",IF(AND(R[1]C[-5]+0=3000,R[1]C[-1]>40),""Rapor 40 günü GEÇEMEZ, son raporun heyete çevrilmesi"",IF(AND(R[1]C[-5]+0=4000,R[1]C[-1]>30),""Rapor 30 günü GEÇEMEZ, son raporun heyete çevrilmesi"",IF(AND(R[1]C[-5]+0=5000,R[1]C[-1]>40),""Rapor 40 günü GEÇEMEZ, son raporun heyete çevrilmesi"","""")))))" & _
        ""

Bunu hazırladığım makroya eklediğimde " Hata 1004, Range Sınıfının FormulaArray özelliği kurulamıyor" hatası aldım.
Hatayla ilgili internette yaptığım araştırmalarda çeşitli çözüm önerileri buldum ama maalesef işe yaramadı.

Çözümün biri şu şekilde:

Sub renklendir()
Dim MiReemplazo As String
MiReemplazo = "formul"

son = Cells(Rows.Count, "B").End(3).Row
For sat = 4 To son
    Cells(sat, "P").Select
    
    theformulapart1 = "=IF(R[1]C[-14]="""","""",IFERROR(IF(ROW()-2-MATCH(R[1]C[-14]&R[1]C[-10],R3C2:R[1]C[-14]&R3C6:R[1]C[-10],0)=0,"""",MATCH(R[1]C[-14]&R[1]C[-10],R1C2:R[1]C[-14]&R1C6:R[1]C[-10],0)& "".Satırda var""),""""))&CHAR(10)&IF(R1C16-R[1]C[-10]<1,""Sonraki Aya Ait Rapor"","""")&CHAR(10)&IF(R[1]C[-7]>0,""Yatış Ayrı Girilmiş Mi?"","""")&CHAR(10)&IF(R[1]C[4]=""x"","""",IFERROR(IF(R" & _
        "OW()=SMALL(IF(R4C10:R4151C10>=R1C16,IF(MIN(IF(R4C2:R4151C2=R[1]C2,R4C10:R4151C10))=R4C10:R4151C10,ROW(R4C1:R4151C1))),ROW(R1C1))," & MiReemplazo
    theFormulaPart2 = "Varsa Daha Önce Kullandığı Bu Yıla Ait Raporları Ekleyiniz"",""""),""""))&CHAR(10)&IF(AND(R[1]C[-5]+0=1000,R[1]C[-1]>40),""Rapor 40 günü GEÇEMEZ, son raporun heyete çevrilmesi"",IF(AND(R[1]C[-5]+0=2000,R[1]C[-1]>40),""Rapor 40 günü GEÇEM" & _
        "EZ, son raporun heyete çevrilmesi"",IF(AND(R[1]C[-5]+0=3000,R[1]C[-1]>40),""Rapor 40 günü GEÇEMEZ, son raporun heyete çevrilmesi"",IF(AND(R[1]C[-5]+0=4000,R[1]C[-1]>30),""Rapor 30 günü GEÇEMEZ, son raporun heyete çevrilmesi"",IF(AND(R[1]C[-5]+0=5000,R[1]C[-1]>40),""Rapor 40 günü GEÇEMEZ, son raporun heyete çevrilmesi"","""")))))" & _
        ""
    With Selection
        .FormulaArray = theformulapart1
        .Replace MiReemplazo, theFormulaPart2
    End With
    
    Cells(sat, "P") = Cells(sat, "P").Value
    
    If Cells(sat, "P").Value <> "" Then
        If Replace(Cells(sat, "P").Value, "Satırda", "") <> Cells(sat, "P").Value Then
            bas = WorksheetFunction.SearchB("Satırda var", Cells(sat, "P").Value)
            Cells(sat, "P").Characters(Start:=1, Length:=bas + 10).Font.Color = vbRed
        End If
        If Replace(Cells(sat, "P"), "Sonraki", "") <> Cells(sat, "P") Then
            bas = WorksheetFunction.SearchB("Sonraki", Cells(sat, "P"))
            Cells(sat, "P").Characters(Start:=bas, Length:=bas + 21).Font.Color = vbBlue
        End If
        If Replace(Cells(sat, "P"), "Yatış", "") <> Cells(sat, "P") Then
            bas = WorksheetFunction.SearchB("Yatış", Cells(sat, "P"))
            Cells(sat, "P").Characters(Start:=bas, Length:=bas + 22).Font.Color = -6279056
        End If
        If Replace(Cells(sat, "P"), "Varsa", "") <> Cells(sat, "P") Then
            bas = WorksheetFunction.SearchB("Varsa", Cells(sat, "P"))
            Cells(sat, "P").Characters(Start:=bas, Length:=bas + 57).Font.Color = vbGreen
        End If
        If Replace(Cells(sat, "P"), "GEÇEMEZ", "") <> Cells(sat, "P") Then
            bas = WorksheetFunction.SearchB("Geçemez", Cells(sat, "P")) - 14
            Cells(sat, "P").Characters(Start:=bas, Length:=bas + 68).Font.Color = 49407
        End If
    End If
Next
End Sub

Eğer bilen bir arkadaşımız bu dizi formülünü makro ile çalıştırabilirse istediğiniz olur diye düşünüyorum.

 

[teyadih]

İlginiz ve emeğiniz için çok teşekkür ederim sayın YUSUF44