• DİKKAT

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

Girilen değere göre renk verme

Katılım
8 Temmuz 2016
Mesajlar
52
Excel Vers. ve Dili
excell 10
Arkadaşlar merhaba,

Elimde aşağıdaki gibi bir kod mevcut. Ancak ihtiyacımı karşılamıyor. Daha önce sayın "çıtır"ın yardımıyla koşullu biçimlendirme ile istediğim sonucu elde etmiştim.
Ancak şuan elimde 10 farklı değişken mevcut.

Girmiş olduğum değerler "sayfa2" de "B,C ve G" sütununda önem teşkil etmekte. Eğer bu değerleri doğru olarak sağlıyorsa "sayfa1" de sadece Lot no yazan kısımda ki karşılığının renklenmesi gerekiyor.

Şöylede bir durum var. B ve C sütunları tekrardan yazılmış olsa bile her zaman "G" sütunundaki değeri dikkate almalı.
Örnekte detaylıca anlattım.
Bir kaç değişiklik ile aşağıdaki kod güncellenebilir mi ?

Desteğiniz için şimdiden teşekkür ederim.





Kod:
Private Sub Worksheet_Activate()
'12.11.2018  saat  10:39


        For j = 3 To Worksheets("Sayfa1").Cells(Rows.Count, "B").End(3).Row
       
                Worksheets("Sayfa1").Cells(j, 2).Interior.Color = xlNone
                Worksheets("Sayfa1").Cells(j, 10).Interior.Color = xlNone
       
       
        Next

For i = 3 To Worksheets("Sayfa2").Cells(Rows.Count, "G").End(3).Row

    If Worksheets("Sayfa2").Cells(i, 7) = "HAZIR" Then
   
   
        For j = 3 To Worksheets("Sayfa1").Cells(Rows.Count, "B").End(3).Row
       
            If Worksheets("Sayfa1").Cells(j, 2) = Worksheets("Sayfa2").Cells(i, 2) Then
           
                Worksheets("Sayfa1").Cells(j, 2).Interior.Color = RGB(0, 255, 0)
                Range(Worksheets("Sayfa1").Cells(j, 5), Worksheets("Sayfa1").Cells(j, 16)).Interior.Color = RGB(0, 255, 0)
                yeşilsay1 = yeşilsay1 + 1
                yeşilmetin1 = yeşilmetin1 & Worksheets("Sayfa1").Cells(j, 1) & ", "
               
            End If
       
        Next
   
    ElseIf Worksheets("Sayfa2").Cells(i, 7) = "BEKLEMEDE" Then
   
   
        For j = 3 To Worksheets("Sayfa1").Cells(Rows.Count, "B").End(3).Row
       
            If Worksheets("Sayfa1").Cells(j, 2) = Worksheets("Sayfa2").Cells(i, 2) Then
           
                Worksheets("Sayfa1").Cells(j, 2).Interior.Color = RGB(255, 0, 0)
                Range(Worksheets("Sayfa1").Cells(j, 5), Worksheets("Sayfa1").Cells(j, 16)).Interior.Color = RGB(255, 0, 0)
                kırmızısay1 = kırmızısay1 + 1
                kırmızımetin1 = kırmızımetin1 & Worksheets("Sayfa1").Cells(j, 1) & ", "
               
            End If
       
        Next
   
   
   
    End If
   
   
Next



End Sub
 

Ekli dosyalar

Geri
Üst