• DİKKAT

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

Satır rengi

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.
 

Ekli dosyalar

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?
 

Ekli dosyalar

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

C++: 
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
 
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.
 
I sütununda aynı veriden birden fazla olabiliyor, bunlar arasındaki farklı özelliği olanı da J sütununa yazarak ayrı bir renklendirmek istiyorum.
 
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.
 

Ekli dosyalar

  • 15.jpg
    15.jpg
    52.2 KB · Görüntüleme: 2
Kodu revize ettim. Tekrar deneyiniz.
 
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.
 
Boş hücreler için küçük bir revize daha yaptım. Deneyiniz.
 
Öyle olmaması gerekir. Denemiştim ama gözümden kaçan birşey mi var acaba..
 
Dosyayı deneyip sonucu bildirirseniz sevinirim.
 

Ekli dosyalar

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

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

Çünkü ben tıkladığımda renkler duruyor.
 
Bu bilgiyi lütfen profilinizede yazınız. Bizlerin profilindeki gibi yazabilirsiniz.

Dediğim gibi ben sayfalarda I-L arasında gezinirken renkler duruyor.
 
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 www.excel.web.tr

#32 nolu mesajımda paylaştığım dosyayı bu yönde revize ettim. Tekrar deneyiniz.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst