Seçilen Hücrenin Mükerrerlerini Boyama

[dehamuhtar]

Merhaba,
Mükerrer ile ilgili tüm aramalarıma rağmen bulamadım, eğer tekrar olmuşsa özür dilerim.
Örnekteki dosyada hangi isme tıklarsam onun mükerrerlerinin boyanmasını istiyorum.
Daha önce öyle bir örnek görmüştüm ama şimdi bulamadım (Yanılmıyorsam Nöbetlerle ilgili bir dosyaydı).
Şimdiden teşekkür ederim.

 

[Ömer]

Merhaba,

Çalışma sayfasının kod bölümüne kopyalayın.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
    Dim alan As Range, c As Range, Adr As Variant
 
    Set alan = Range("B2:K6")[COLOR=darkgreen]'Veri alanını buraya yazın.[/COLOR]
 
    If Intersect(Target, alan) Is Nothing Then Exit Sub
 
    alan.Interior.ColorIndex = 0
    If Target = "" Then Exit Sub
 
    With alan
        Set c = .Find(Target, , xlValues, xlWhole)
        If Not c Is Nothing Then
            Adr = c.Address
            Do
                Cells(c.Row, c.Column).Interior.ColorIndex = 6
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> Adr
        End If
    End With
 
End Sub

.

 

[mersilen]

Selam,
Alternatif olsun, daha önceki bir çalışmada banada lazım olmuştu.
Linki inceleyin.

http://www.excel.web.tr/f48/imlecle-secilen-hucreye-gore-dolgu-renk-olu-turmak-t84604.html

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, [c105:v135]) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
[c105:v135].FormatConditions.Delete
[c105:v135].FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
    Formula1:="=" & """" & Target & """"
[c105:v135].FormatConditions(1).Interior.ColorIndex = 45
End Sub

 

[dehamuhtar]

Çok teşekkür ederim hızlı cevaplarınız için sayın Ömer ve sayın mersilen.