Aynı iki hücrenin ikisininde renklenmesi

[k.guclu]

İyi günler Arkadaşlar

Yaptığım bir işaret tablosunda C ve P sütünlarına kısaltılmış işaretler giriyorum ve bu kısaltmalardan aynı isimde iki değer olduğunda iki hücrenin renklenmesini istiyorum fakat ben sadece birini renklendirebiliyorum.

Örnek olarak
"C2" ile "P17" aynı olsun ikisinin mesela kırmızı
"C18" ile "P3" aynı olsun ikisinin mesela yeşil
renkler rastgele olabilir.

Kodlar aşağıdaki gibi ve yaptığım çalışmayı orjinal halde göndeiryorum.
Bu konuda bir başlık veya yol açarsanızda çok memnun olurum.

Tüm gününüz güzel geçmesi temennisiyle hayırlı günler.

'C sütununun en sonundan yukarıya doğru bir eksilterek döngü kuruyoruz
For renk1 = [C65536].End(3).Row To 1 Step -1
'eğer say ile aynı olan değerlerin birden fazlasını renk1diriyoruz
If WorksheetFunction.CountIf(Range("C1:C" & renk1), Range("C" & renk1)) > 1 Then Range("C" & renk1).Interior.ColorIndex = 3
'döngü sonu
Next
'sub yordamından çıkış

'P sütununun en sonundan yukarıya doğru bir eksilterek döngü kuruyoruz
For renk2 = [P65536].End(3).Row To 1 Step -1
'eğer say ile aynı olan değerlerin birden fazlasını renk2diriyoruz
If WorksheetFunction.CountIf(Range("P1:P" & renk2), Range("P" & renk2)) > 1 Then Range("P" & renk2).Interior.ColorIndex = 3
'döngü sonu
Next
'sub yordamından çıkış

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim X As Byte, İşaret() As Variant, Renk() As Variant
    Dim Son_Satır As Long, Hücre As Range
    İşaret = Array("A", "B", "C", "D", "E", "F", "G", "H", "I")
    Renk = Array(3, 4, 6, 7, 8, 15, 16, 22, 33)
    If Intersect(Target, [C2:C65536,P2:P65536]) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Son_Satır = [A65536].End(3).Row
    Range("C2:C" & Son_Satır, "P2:P" & Son_Satır).Interior.ColorIndex = xlNone
    For Each Hücre In Range("C2:C" & Son_Satır, "P2:P" & Son_Satır)
    If Hücre.Value <> "" Then
    If (WorksheetFunction.CountIf(Range("C2:C65536"), Hücre.Value) + WorksheetFunction.CountIf(Range("P2:P65536"), Hücre.Value)) > 1 Then
        For X = 0 To UBound(İşaret)
        If Hücre = İşaret(X) Then
        Hücre.Interior.ColorIndex = Renk(X)
        Exit For
        End If
        Next
    End If
    End If
    Next
    Application.ScreenUpdating = True
End Sub

 

[k.guclu]

üstadım mükemmelsin çok teşekkür ederim, eline canına sağlık, işin rast gelsin.

Üstat farklı işaretler girdim mi olmuyor.
aynı farklı iki işaret giriyorum renklendirmiyor.
mesela DD1 yazdım iki farklı hücreye bişey olmadı.

SAYGILARIMLA

 

[Korhan Ayhan]

Selamlar,

Dikkat ederseniz kodun içine girilecek işaretler ve renkler dizileri tanımlanmıştır. Eğer işaret dizisinde olmayan bir işaret girerseniz renklenmez. Diziye girebileceğiniz tüm işaretleri eklemelisiniz. Tabiki renk dizisinede bu işarete vermek istediğiniz renk kodunu eklemelisiniz.

 

[k.guclu]

Üstat buraya girilen işaretler benim kontrolüm dışında oluyor yani bunu başka bir arkadaş girdiğinde kendi kısaltmalarını kullanır. Bunu genellemek mümkün olmaz mı?

İlginizden yardımlarınızdan dolayı teşekkür ederim.

 

[k.guclu]

arkadaşlar
http://www.excel.web.tr/f48/cift-hucreleri-bulmak-t66430.html

adreste çözümü gördüm tavsiyem burayı inceleyin.

 

[Korhan Ayhan]

Selamlar,

Sn. k.guclu,

Siz sorunuzda her çift veri için farklı renk kullanılmasını istemişsiniz. Fakat sayfada en fazla 56 renk kullanılabilir. Bunlarında bazısı koyu renk olduğu için zaten tercih edilmiyor. Bu sebeple üstteki mesajımdaki kodu önerdim. Eğer farklı gireceğiniz veri sayısı 56 dan fazla ise zaten size renk paletindeki renkler yetmeyecektir.

Ayrıca vermiş olduğunuz linkteki cevapta sadece kırmızı renk kullanılmış. Eğer size tek renk yeterli ise makro kullanmadan koşullu biçimlendirme ilede sorununuzu çözebiliriz.

Koşullu biçimlendirme ile yapmak isterseniz.

C sütununu seçin.
Biçim-Koşullu Biçimlendirme menüsünü açın.
Koşul kısmından "Formül" seçeneğini seçin.
Yandaki kutucuğa aşağıdaki formülü uygulayın.
Biçim bölümünden dolgu rengi olarak "Kırmızı" rengi seçin ve tamam deyin.
Aynı biçimlendirmeyi P sütununa kopyalayın.

=EĞER(VE(C1<>"İşa.";C1<>"");EĞER((EĞERSAY($C:$C;C1)+EĞERSAY($P:$P;C1))>1;1;0))

 

[k.guclu]

Üstat dediklerinde haklısın ama yapacak birşey bulamadım. İstediklerimi yapabilmem için bayağı pişmem gerek sanırım.

Üstadım çok teşekkür ederim istediğim tam buydu farklı renkler benim için lüks olur şu an zaten.

Üstat ilginden alakadan dolayı çok teşekkür üç gündür bunun için çabalıyordum. Çok kısa ve öz bir çözüm sundun.

Bu örneğin tüm arkadaşlarımıza örnek olup ufuklarını açmaya vesile olmasını temenni ederim.

SAYGILARIMI SUNUYORUM.