Soru Hücre değerine göre satır renklendirme

[sakaryatuna]

Merhabalar,

Hücre değerine göre hücrenin renklenmesini istiyorum.
Bu işlem koşullu biçimlendirme ile de oluyor. Ancak hücreleri birleştirip değer yazdığınızda ve sonra, birleştirilmiş hücreyi eski hale getirdiğinizde biçim uygulanacak hücre aralığı bozuluyor.
Bu sebeple renklendirmeyi Vba kodu ile yapmak isityorum

Örnek Olarak;
Excel listemizin B3:G800 aralığında, Ankara, İstanbul, Bursa, Balıkesir, İzmir... gib farklı 10'un üzeride değerler var.
Bu değerlerin girildiği her hücrenin farklı renkte olmasını istiyorum.
İlginize şimdiden teşekkür ederim.

 

[uzmanamele]

Merhaba
Sayfanın kod bölümüne yazarak deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("B3:G800")) Is Nothing Then Exit Sub
If Target.Text = "Ankara" Then Target.Interior.ColorIndex = 3
If Target.Text = "İstanbul" Then Target.Interior.ColorIndex = 4
If Target.Text = "Bursa" Then Target.Interior.ColorIndex = 5
If Target.Text = "Balıkesir" Then Target.Interior.ColorIndex = 6
If Target.Text = "İzmir" Then Target.Interior.ColorIndex = 7
End Sub

 

[sakaryatuna]

İlginiz için teşekkür ederim. İki sorum olacak:

İlgili değeri girince hücre renkleniyor, ancak değeri silince dolgu rengi kalıyor. Hücreyi temizleyince dolgunun da otomatik kalkması mümkün mü ?

İkinci olarak büyük/küçük harfe duyarlı olmasın istiyorum. Küçük harf ile ankara yazınca dolgu olmuyor, büyük harf ile başlarsa kod çalışıyor.

 

[sakaryatuna]

Yardımlarınızı bekliyorum

 

[Korhan Ayhan]

Deneyiniz.

Renk kartelası için inceleyiniz.

VBA ColorIndex Property of Excel Range Shape Chart Background Color

analysistabs.com

5 il için örnekledim.

Option Explicit
Option Base 1

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Rng As Range, Aranan As Variant, Renk As Variant
   
    If Intersect(Target, Range("B3:G800")) Is Nothing Then Exit Sub
   
    Aranan = Array("ANKARA", "ADANA", "AMASYA", "ANTALYA", "BURSA")
    Renk = Array(3, 4, 6, 8, 22)
   
    For Each Rng In Intersect(Target, Range("B3:G800"))
        If Rng = "" Then
10          Rng.Interior.ColorIndex = xlNone
        Else
            On Error GoTo 10
            Rng.Interior.ColorIndex = Renk(WorksheetFunction.Match(UCase(Replace(Replace(Rng, "ı", "I"), "i", "İ")), Aranan, 0))
        End If
    Next
End Sub

 

[sakaryatuna]

Korhan bey çok teşekkür ederim, emeğinize ve elinize sağlık.