Verilere Göre Otomatik Hücre Renklendirme

Korhan Ayhan · 21 Mart 2014

Forumda koşullu biçimlendirme ifadesi ile arama yapınız. Bu konuda oldukça fazla örnek var.

Ömer BARAN · 21 Mart 2014

Koşullu Biçimlendirme

Rakamsal veriniz A1 de ve renklendireceğiniz hücre B1 ise ve biçimi uygulayacağınız alan B sütununda ise (biçimlendirme yapılmış hücreyi aşağı doğru kopyalarsanız benzer biçimlendirme o hücrelere de uygulanacaktır)
Koşullu biçimlendirme -> Yeni Kural -> Biçimlendirilecek hücre için formül kullan seçilip;
-Biçim koşulu 1 için : =VE($A1<>"";$A1>=0;$A1<1500) Renk: Kırmızı seçilecek
-Biçim koşulu 2 için : =VE($A1>=1500;$A1<3000) Renk: Sarı seçilecek
-Biçim koşulu 1 için : =$A1>=3000 Renk: Mavi seçilecek

Umarım işinizi görür, formüllerdeki $ işaretinin yerini değiştirerek / silerek uygulayıp sonra aşağı, sağa kopyalayarak denemeler yaparsanız farkları görürsünüz ve bu olayı öğrenmiş olursunuz.
İyi günler dilerim.

mehmettas_konya · 21 Mart 2014

Yok yok yok olmuyor

RedStar · 29 Eylül 2014

HD1975' Alıntı:
Korhan Beyin yaptığı makro ile renk süzme kodları var ve kullanıyorum.
Gayetde güzel performans veriyor.
ücrelerde formül olmayacağı için
Sanırım tablonuza uyarlayabilrseniz işinizi görür,hücrelerde formül olmayacağı için sıkıntı kalkar.

Option Explicit
Sub RENKLENDİR()
Dim HÜCRE As Range, BUL As Range

Range("A25:K65536").Interior.ColorIndex = xlNone

For Each HÜCRE In Range("B25:B" & Range("B65536").End(3).Row)
If HÜCRE.Value <> Empty Then
Set BUL = Sheets("Sayfa8").Range("A:A").Find(HÜCRE.Value, LookAt:=xlWhole)
If Not BUL Is Nothing Then
If UCase(Sheets("Sayfa8").Cells(BUL.Row, "F")) = "BANKA VE PTT" Then
Range("A" & HÜCRE.Row, "K" & HÜCRE.Row).Interior.ColorIndex = 38
If UCase(Sheets("Sayfa8").Cells(BUL.Row, "F")) = "BANKA VE PTT" Then
Range("A" & HÜCRE.Row, "K" & HÜCRE.Row).Interior.ColorIndex = 12
ElseIf UCase(Sheets("Sayfa8").Cells(BUL.Row, "F")) = "EVİNE GİDİLECEK (TELEFONLA ULAŞILAMIYOR)" Then
Range("A" & HÜCRE.Row, "K" & HÜCRE.Row).Interior.ColorIndex = 5
ElseIf UCase(Replace(Replace(Sheets("Sayfa8").Cells(BUL.Row, "F"), "ı", "I"), "i", "İ")) = "ÖZEL TAKİP" Then
Range("A" & HÜCRE.Row, "K" & HÜCRE.Row).Interior.ColorIndex = 43
ElseIf UCase(Replace(Replace(Sheets("Sayfa8").Cells(BUL.Row, "F"), "ı", "I"), "i", "İ")) = "MUSTAFA BEY" Then
Range("A" & HÜCRE.Row, "K" & HÜCRE.Row).Interior.ColorIndex = 10
ElseIf UCase(Replace(Replace(Sheets("Sayfa8").Cells(BUL.Row, "F"), "ı", "I"), "i", "İ")) = "ÇEK VERECEK" Then
Range("A" & HÜCRE.Row, "K" & HÜCRE.Row).Interior.ColorIndex = 6
ElseIf UCase(Replace(Replace(Sheets("Sayfa8").Cells(BUL.Row, "F"), "ı", "I"), "i", "İ")) = "KREDİ KARTI İLE ÖDEME YAPACAK" Then
Range("A" & HÜCRE.Row, "K" & HÜCRE.Row).Interior.ColorIndex = 7
ElseIf UCase(Replace(Replace(Sheets("Sayfa8").Cells(BUL.Row, "F"), "ı", "I"), "i", "İ")) = "HAYATİ BEY" Then
Range("A" & HÜCRE.Row, "K" & HÜCRE.Row).Interior.ColorIndex = 33
ElseIf UCase(Replace(Replace(Sheets("Sayfa8").Cells(BUL.Row, "F"), "ı", "I"), "i", "İ")) = "FATİH BEY" Then
Range("A" & HÜCRE.Row, "K" & HÜCRE.Row).Interior.ColorIndex = 51
ElseIf UCase(Replace(Replace(Sheets("Sayfa8").Cells(BUL.Row, "F"), "ı", "I"), "i", "İ")) = "İSMAİL BEY" Then
Range("A" & HÜCRE.Row, "K" & HÜCRE.Row).Interior.ColorIndex = 11
ElseIf UCase(Replace(Replace(Sheets("Sayfa8").Cells(BUL.Row, "F"), "ı", "I"), "i", "İ")) = "YASEMİN HANIM" Then
Range("A" & HÜCRE.Row, "K" & HÜCRE.Row).Interior.ColorIndex = 12
ElseIf UCase(Replace(Replace(Sheets("Sayfa8").Cells(BUL.Row, "F"), "ı", "I"), "i", "İ")) = "HATİCE ALTINOK" Then
Range("A" & HÜCRE.Row, "K" & HÜCRE.Row).Interior.ColorIndex = 14
ElseIf UCase(Replace(Replace(Sheets("Sayfa8").Cells(BUL.Row, "F"), "ı", "I"), "i", "İ")) = "KADRİ BEY" Then
Range("A" & HÜCRE.Row, "K" & HÜCRE.Row).Interior.ColorIndex = 15
Else
Range("A" & HÜCRE.Row, "K" & HÜCRE.Row).Interior.ColorIndex = 38
End If
End If
End If

Next

Set BUL = Nothing

MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

Ayrıca koşulda üçden fazla verebilirsiniz.

Yukarıdaki kodları Çalışma kitabındaki Ana isimli safadaki A3 den ile G3 arasındaki verilerimi istediğim dolgu rengiyle renklendirmek için uyarlamak istiyorum.Yardımcı olursanız sevinirim.

Örnegin G sütuna baksın Ocak yazan satırları Kırmızı dolgu rengiyle Şubat yazanları Sarı dolğu rengiyle verinin geçtiği bütün satırları renklendirsin.

Ana isimli çalışma sayfasında =MOD(SATIR();8)=2 formulünü kullanarak 8,16,24 gibi 8 ve katları olan satırları komple sarı dolgu rengiyle biçimlendirdim.Bu satırları uyarlamak istediğim kodlarda muaf tutarak renklendirmek istiyorum.

Örnek dosyam ektedir.

İlgi ve alakanız için çok teşekkür ederim.

RedStar · 30 Eylül 2014

Ustalar yardımlarınızı bekliyorum teşekkürler.

liman61 · 2 Ekim 2014

Hepinize paylaşımlarınız için teşekkürler. Çok araştırdım ama sorum için bir yanıt bulamadım.
Sorunum şöyle. Elimde 10 tane sayı var. bu sayılar 10, 12, 10, 25, 30, 28, 18, 26, 15, 30 olsun bunlardan koşullu biçimlendirme yaparak en büyük ve en küçük olanları dolgu rengi ile belirlemek istiyorum. Birden fazla en büyük veya ek küçük olması durumunda sadece birer tanesini işaretleyecek. Yani yukarıdaki sayılardan en küçük için sadece 10 ve en büyük sayı için 30 un birini işaretleyecek.

tahsinanarat · 3 Ekim 2014

Koşullu biçimlendirmeniz aynı kalsın,Aşağıdaki makroyu deneyiniz

Kod:

Sub RENKLENDİR()
    Dim HÜCRE As Range

    For Each HÜCRE In Range("g2:g" & [a65536].End(3).Row)

        With HÜCRE.Interior
        Select Case True
            Case InStr(1, HÜCRE.Value, "Ocak")
            .ColorIndex = 4
            Case InStr(1, HÜCRE.Value, "Şubat")
            .ColorIndex = 7
            Case InStr(1, HÜCRE.Value, "Mart")
            .ColorIndex = 5
            Case InStr(1, HÜCRE.Value, "Nisan")
            .ColorIndex = 6
            Case InStr(1, HÜCRE.Value, "Mayıs")
            .ColorIndex = 8
            Case InStr(1, HÜCRE.Value, "Haziran")
            .ColorIndex = 9
            Case InStr(1, HÜCRE.Value, "Temmuz")
            .ColorIndex = 27
            Case InStr(1, HÜCRE.Value, "Ağustos")
            .ColorIndex = 33
            Case InStr(1, HÜCRE.Value, "Eylül")
            .ColorIndex = 40
            Case InStr(1, HÜCRE.Value, "Ekim")
            .ColorIndex = 46
            Case InStr(1, HÜCRE.Value, "Kasım")
            .ColorIndex = 11
            Case InStr(1, HÜCRE.Value, "Aralık")
            .ColorIndex = 12
            Case Else
            .ColorIndex = 0
        End Select
        End With
    Next
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

RedStar · 3 Ekim 2014

Abi çok teşekkür ederim eline sağlık tek bir sorun var sadece g sütunundakileri renklendiriyor.Bu dolgu rengini g sütununda yer alan degere göre tüm satır şeklinde yapabilirmiyiz? Mesela örnek dosyadaki g3 de yer alan ocak verisinin yer aldığı bütün satırı (a3,b3,c3,d3,f3 ) g3 deki aynı dolgu rengiyle renklendirebilirmiyiz.

tahsinanarat · 3 Ekim 2014

Satırların da renklenmesini istiyorsanız aşağıdaki kodları kullanın, Ana isimli çalışma sayfasında =MOD(SATIR();8)=2 formülünüz aynen kalmak şartıyla;

Kod:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [G:G]) Is Nothing Then Exit Sub
satirlar = "A" & Target.Row & ":G" & Target.Row
Select Case Target
Case "Ocak": Range(satirlar).Interior.ColorIndex = 3
Case "Şubat": Range(satirlar).Interior.ColorIndex = 4
Case "Mart": Range(satirlar).Interior.ColorIndex = 5
Case "Nisan": Range(satirlar).Interior.ColorIndex = 6
Case "Mayıs": Range(satirlar).Interior.ColorIndex = 7
Case "Haziran": Range(satirlar).Interior.ColorIndex = 8
Case "Temmuz": Range(satirlar).Interior.ColorIndex = 9
Case "Ağustos": Range(satirlar).Interior.ColorIndex = 10
Case "Eylül": Range(satirlar).Interior.ColorIndex = 11
Case "Ekim": Range(satirlar).Interior.ColorIndex = 12
Case "Kasım": Range(satirlar).Interior.ColorIndex = 13
Case "Aralık": Range(satirlar).Interior.ColorIndex = 14
End Select
End Sub

Mesajımı gönderdiğimde bu isteğinizi gördüm

RedStar · 3 Ekim 2014

Abi kod bölümüne ekledim kaydetmek isteyince macro adı vermemi istedi makro adınıda verdim çalıştırmak isteyince compile error Expected End Sub hatası veriyor.

Kod:

Sub Tahsinabi()
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [G:G]) Is Nothing Then Exit Sub
satirlar = "A" & Target.Row & ":G" & Target.Row
Select Case Target
Case "Ocak": Range(satirlar).Interior.ColorIndex = 3
Case "Şubat": Range(satirlar).Interior.ColorIndex = 4
Case "Mart": Range(satirlar).Interior.ColorIndex = 5
Case "Nisan": Range(satirlar).Interior.ColorIndex = 6
Case "Mayıs": Range(satirlar).Interior.ColorIndex = 7
Case "Haziran": Range(satirlar).Interior.ColorIndex = 8
Case "Temmuz": Range(satirlar).Interior.ColorIndex = 9
Case "Ağustos": Range(satirlar).Interior.ColorIndex = 10
Case "Eylül": Range(satirlar).Interior.ColorIndex = 11
Case "Ekim": Range(satirlar).Interior.ColorIndex = 12
Case "Kasım": Range(satirlar).Interior.ColorIndex = 13
Case "Aralık": Range(satirlar).Interior.ColorIndex = 14
End Select
End Sub

tahsinanarat · 3 Ekim 2014

Sayfanın kod bölümüne eklemelisin, g sütununda (ay ismini yazdığında) işlem yaptığın satır renklenecek
Eğer evvelce yazılmış bir alanı kontrol ettirmek istiyorsan

Kod:

Sub F2_ENTER()
    Dim Hucre As Range

    Range("g1").Select

    For Each Hucre In Range("g2:g1000")'satır sonunu kendine göre belirle
        SendKeys "{F2}~", True
    Next
End Sub

ZorBey_ · 3 Ekim 2014

Sayın tahsinanarat'ın kodları bende gayet güzel çalışıyor.
Sayın RedStar
Sub Tahsinabi() Silin.
Private Sub Worksheet_Change(ByVal Target As Range)

tahsinanarat · 3 Ekim 2014

Dosyanız ekte

G sutununda ay ismini girdiğinizde (kelimeler tam olarak eşleşmeli, Yani ilk harfler büyük) renklenecek, F2 enter yaptığınızda belirtiğiniz satır kadar F2 enter yaparak renklenmesini sağlayacaktır.

RedStar · 3 Ekim 2014

Tahsin abi ve Sn.Zorbey_ başta olmak üzere tüm emeği geçenlere çok teşekkürler.İyi bayramlar.

liman61 · 9 Ekim 2014

Ustalar yardım edebilir misiniz?
Sorunum şöyle. Elimde 10 tane sayı var. bu sayılar 10, 12, 10, 25, 30, 28, 18, 26, 15, 30 olsun bunlardan koşullu biçimlendirme yaparak en büyük ve en küçük olanları dolgu rengi ile belirlemek istiyorum. Birden fazla en büyük veya ek küçük olması durumunda sadece birer tanesini işaretleyecek. Yani yukarıdaki sayılardan en küçük için sadece 10 ve en büyük sayı için 30 un birini işaretleyecek.

etiteks · 11 Kasım 2016

Merhaba

Ben bu işin aslında dışındayım ama işyeri için ortak excelden yapmış olduğum iş takip listemde ensonda bulunan hazır butonu seçildiğinde baştan hazırında dahil olduğu satırın kople yeşil olmasını istiyorum ama yapamadım yardım ve bilgi paylasımlarınızı rica ediyorum teşekkürler

HD1975' Alıntı:
Korhan Beyin yaptığı makro ile renk süzme kodları var ve kullanıyorum.
Gayetde güzel performans veriyor.
ücrelerde formül olmayacağı için
Sanırım tablonuza uyarlayabilrseniz işinizi görür,hücrelerde formül olmayacağı için sıkıntı kalkar.

Option Explicit
Sub RENKLENDİR()
Dim HÜCRE As Range, BUL As Range

Range("A25:K65536").Interior.ColorIndex = xlNone

For Each HÜCRE In Range("B25:B" & Range("B65536").End(3).Row)
If HÜCRE.Value <> Empty Then
Set BUL = Sheets("Sayfa8").Range("A:A").Find(HÜCRE.Value, LookAt:=xlWhole)
If Not BUL Is Nothing Then
If UCase(Sheets("Sayfa8").Cells(BUL.Row, "F")) = "BANKA VE PTT" Then
Range("A" & HÜCRE.Row, "K" & HÜCRE.Row).Interior.ColorIndex = 38
If UCase(Sheets("Sayfa8").Cells(BUL.Row, "F")) = "BANKA VE PTT" Then
Range("A" & HÜCRE.Row, "K" & HÜCRE.Row).Interior.ColorIndex = 12
ElseIf UCase(Sheets("Sayfa8").Cells(BUL.Row, "F")) = "EVİNE GİDİLECEK (TELEFONLA ULAŞILAMIYOR)" Then
Range("A" & HÜCRE.Row, "K" & HÜCRE.Row).Interior.ColorIndex = 5
ElseIf UCase(Replace(Replace(Sheets("Sayfa8").Cells(BUL.Row, "F"), "ı", "I"), "i", "İ")) = "ÖZEL TAKİP" Then
Range("A" & HÜCRE.Row, "K" & HÜCRE.Row).Interior.ColorIndex = 43
ElseIf UCase(Replace(Replace(Sheets("Sayfa8").Cells(BUL.Row, "F"), "ı", "I"), "i", "İ")) = "MUSTAFA BEY" Then
Range("A" & HÜCRE.Row, "K" & HÜCRE.Row).Interior.ColorIndex = 10
ElseIf UCase(Replace(Replace(Sheets("Sayfa8").Cells(BUL.Row, "F"), "ı", "I"), "i", "İ")) = "ÇEK VERECEK" Then
Range("A" & HÜCRE.Row, "K" & HÜCRE.Row).Interior.ColorIndex = 6
ElseIf UCase(Replace(Replace(Sheets("Sayfa8").Cells(BUL.Row, "F"), "ı", "I"), "i", "İ")) = "KREDİ KARTI İLE ÖDEME YAPACAK" Then
Range("A" & HÜCRE.Row, "K" & HÜCRE.Row).Interior.ColorIndex = 7
ElseIf UCase(Replace(Replace(Sheets("Sayfa8").Cells(BUL.Row, "F"), "ı", "I"), "i", "İ")) = "HAYATİ BEY" Then
Range("A" & HÜCRE.Row, "K" & HÜCRE.Row).Interior.ColorIndex = 33
ElseIf UCase(Replace(Replace(Sheets("Sayfa8").Cells(BUL.Row, "F"), "ı", "I"), "i", "İ")) = "FATİH BEY" Then
Range("A" & HÜCRE.Row, "K" & HÜCRE.Row).Interior.ColorIndex = 51
ElseIf UCase(Replace(Replace(Sheets("Sayfa8").Cells(BUL.Row, "F"), "ı", "I"), "i", "İ")) = "İSMAİL BEY" Then
Range("A" & HÜCRE.Row, "K" & HÜCRE.Row).Interior.ColorIndex = 11
ElseIf UCase(Replace(Replace(Sheets("Sayfa8").Cells(BUL.Row, "F"), "ı", "I"), "i", "İ")) = "YASEMİN HANIM" Then
Range("A" & HÜCRE.Row, "K" & HÜCRE.Row).Interior.ColorIndex = 12
ElseIf UCase(Replace(Replace(Sheets("Sayfa8").Cells(BUL.Row, "F"), "ı", "I"), "i", "İ")) = "HATİCE ALTINOK" Then
Range("A" & HÜCRE.Row, "K" & HÜCRE.Row).Interior.ColorIndex = 14
ElseIf UCase(Replace(Replace(Sheets("Sayfa8").Cells(BUL.Row, "F"), "ı", "I"), "i", "İ")) = "KADRİ BEY" Then
Range("A" & HÜCRE.Row, "K" & HÜCRE.Row).Interior.ColorIndex = 15
Else
Range("A" & HÜCRE.Row, "K" & HÜCRE.Row).Interior.ColorIndex = 38
End If
End If
End If

Next

Set BUL = Nothing

MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

Ayrıca koşulda üçden fazla verebilirsiniz.

Verilere Göre Otomatik Hücre Renklendirme

Korhan Ayhan

Administrator

Ömer BARAN

Uzman

mehmettas_konya

RedStar

Ekli dosyalar

RedStar

liman61

tahsinanarat

RedStar

tahsinanarat

RedStar

tahsinanarat

ZorBey_

Destek Ekibi

Ekli dosyalar

tahsinanarat

Ekli dosyalar

RedStar

liman61

etiteks