Satır rengi

[Korhan Ayhan]

Merhaba,

Sayfalarda "I" sütunlarına girdiğiniz veriler "Metin" biçiminde olmalıdır. Yoksa makro bu haliyle sonuç vermez.

Dosyayı deneyiniz. Veri ve Renkler sayfaları hariç tüm sayfalarda kod çalışır.

 

[nadirornek]

Sub Renklendir()
Dim S1 As Worksheet, Veri As Range, Son_Veri As Long, Son_Kod As Long

Application.ScreenUpdating = False

Set S1 = Sheets("Renkler")

Son_Kod = S1.Cells(S1.Rows.Count, "A").End(3).Row
Son_Veri = Cells(Rows.Count, "I").End(3).Row
Range("I:L").FormatConditions.Delete

For Each Veri In S1.Range("A2:A" & Son_Kod)
With Range("I2:L" & Son_Veri)
.FormatConditions.Add Type:=xlExpression, Formula1:="=$I2=""" & Veri.Value & """"
.FormatConditions(.FormatConditions.Count).SetFirstPriority
With .FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.ColorIndex = Veri.Offset(0, 1)
.TintAndShade = 0
End With
.FormatConditions(1).StopIfTrue = False
End With
Next

Application.ScreenUpdating = True
End Sub

Renkler kodumun üzerine yeni bir renk özellik daha katabilirmiyiz iki sütuna bakarak.
Kod renkler sayfamın A sütununa bakıyor, B sütununa göre de aktif sayfamın I sütunundaki değere göre de renk veriyor, bu mantıkla çalışıyor. Yanlız aktif sayfamın J sütununa bakarak da yeni bir renk almasını istiyorum.
Bu rengi de yine Renkler sayfasının A ve C sütununa bakarak D sütunu ile de renk verecek. Yeni özellik sayfamın I ve J sütununa göre Renkler sayfasının A ve C sütununa bakarak D sütununa göre de renk verecek buna göre kodu değiştirebilirmiyiz?

 

[Korhan Ayhan]

Umarım doğru anlamışımdır.

Sub Renkleri_Sil()
    Range("I:L").Interior.ColorIndex = xlNone
End Sub

Sub Renklendir()
    Dim S1 As Worksheet, Veri As Range, Son_Veri As Long, Son_Kod As Long
    
    Application.ScreenUpdating = False
    
    Set S1 = Sheets("Renkler")
    
    Son_Kod = S1.Cells(S1.Rows.Count, "A").End(3).Row
    Son_Veri = Cells(Rows.Count, "I").End(3).Row
    Range("I:L").FormatConditions.Delete
    
    For Each Veri In S1.Range("A2:A" & Son_Kod)
        With Range("I2:L" & Son_Veri)
            .FormatConditions.Add Type:=xlExpression, Formula1:="=AND($I2<>"""";$I2=""" & Veri.Value & """)"
            .FormatConditions(.FormatConditions.Count).SetFirstPriority
            With .FormatConditions(1).Interior
                .PatternColorIndex = xlAutomatic
                .ColorIndex = Veri.Offset(0, 1)
                .TintAndShade = 0
            End With
            .FormatConditions(1).StopIfTrue = False
        End With
        With Range("I2:L" & Son_Veri)
            .FormatConditions.Add Type:=xlExpression, Formula1:="=AND($J2<>"""";$J2=""" & Veri.Offset(, 2).Value & """)"
            .FormatConditions(.FormatConditions.Count).SetFirstPriority
            With .FormatConditions(1).Interior
                .PatternColorIndex = xlAutomatic
                .ColorIndex = Veri.Offset(0, 3)
                .TintAndShade = 0
            End With
            .FormatConditions(1).StopIfTrue = False
        End With
    Next

    Application.ScreenUpdating = True
End Sub

 

[nadirornek]

Kod birinci aşamada çalışıyor I sütununa veri girildiğinde renk alıyor, fakat J sütununa veri girdiğimde Renkler sayfasının C sütununa bakarak D Sütununa bakarak renk değişip almıyor.
I sütununa 391 yazdığımda 6 nolu renk kodunu alıyor aynı satırda j sütununada A LE 5 yazdığımda karşılığı olan D sütunundan 10 nolu renk kodunu almıyor.

 

[nadirornek]

I sütununda aynı veriden birden fazla olabiliyor, bunlar arasındaki farklı özelliği olanı da J sütununa yazarak ayrı bir renklendirmek istiyorum.

 

[nadirornek]

I:L sütun aralığı rengini I sütununun değerine göre Renkler sayfasının A sütunu ile karşılaştırıp B sütunundaki karşılık gelen renk kodunu alıyor bu güzel,
I:L sütununda ikinci olması gereken renk özelliği ise J sütunundaki değeri Renkler sayfasında C Sütununda bulup D sütunundaki renk kodunu göre alması.
Renklerin görünmesi gereken tablo ektedir.
Amacım I sütunundaki aynı değeri J sütununa göre ayrı renk verdirmek.

 

[Korhan Ayhan]

Kodu revize ettim. Tekrar deneyiniz.

 

[nadirornek]

Kod çok güzelleşti çalışıyor yanlız I:L sütun aralığında satır olarak veri sildiğimde boş satır renk alıyor, satır sildiğimde renk almasın.

 

[Korhan Ayhan]

Boş hücreler için küçük bir revize daha yaptım. Deneyiniz.

 

[nadirornek]

kodu yenileyince renklerin hepsi silindi

 

[Korhan Ayhan]

Öyle olmaması gerekir. Denemiştim ama gözümden kaçan birşey mi var acaba..

 

[Korhan Ayhan]

Dosyayı deneyip sonucu bildirirseniz sevinirim.

 

[nadirornek]

Sayfalarda I:L sütunlarına tıkladığım anda renkler kayboluyor.

 

[Korhan Ayhan]

Eklediğim dosyada mı bu sorunu yaşıyorsunuz?

Yoksa asıl dosyanızda mı?

 

[nadirornek]

Gönderdiğiniz dosyada tıkladığım anda renkler siliniyor

 

[Korhan Ayhan]

Hangi sürümü kullanıyorsunuz? (Ayrıca bu bilgiyi profilinize yazarsanız daha iyi olur)

Çünkü ben tıkladığımda renkler duruyor.

 

[nadirornek]

2013 sürümü kullanıyorum

 

[Korhan Ayhan]

Bu bilgiyi lütfen profilinizede yazınız. Bizlerin profilindeki gibi yazabilirsiniz.

Dediğim gibi ben sayfalarda I-L arasında gezinirken renkler duruyor.

 

[nadirornek]

Kodu kendi dosyama eklediğimde de aynı sorunu yaşıyorum

 

[Korhan Ayhan]

Sorunun kaynağınız tespit ettim. Ben evde Türkçe sürüm kullanırken işyerinde İngilizce sürüm kullanıyorum.

Aşağıdaki linkte bahsi geçen problemi bu yüzden yaşadık.

Koşullu Biçimlendirme kodunun İngilizce formüllerle yapılması

Merhaba Arkadaşlar, Aşağıda Korhan Ayhan üstada ait VBA Kodu var. Bu koddaki Türkçe formülleri İngilizce yazmanın bir yolu var mıdır ? Sub Bicimlendir() With Range("C7:C999") .FormatConditions.Delete .FormatConditions.Add Type:=xlExpression...

www.excel.web.tr

#32 nolu mesajımda paylaştığım dosyayı bu yönde revize ettim. Tekrar deneyiniz.