hücre renklendirme

[eseseski]

merhaba
Sayfada seçtiğim veya imleci üzerine getirdiğim hücrede bulunan aynı isimli (değerli) bütün hücreler aynı rengi alabilir mi?
Bunu makro ile yapabilir miyiz?
Bilgisi olan arkadaşlar yardımcı olabilir mi? saygılar

 

[YUSUF44]

Aşağıdaki kodları ilgili sayfanın kod bölümüne (sayfa adına sağ tıklayıp kod görüntüle deyince açılan sayfaya) yapıştırıp deneyin:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, [C10:J40]) Is Nothing Then Exit Sub
[C10:J40].Interior.Color = xlNone
If Target = "" Then Exit Sub
For Each hucre In [C10:J40]
    If hucre <> "" And hucre.Value = Target Then
        hucre.Interior.Color = vbRed
    End If
Next
End Sub

 

[YUSUF44]

Yalnız bu kod hücre seçince çalışır, fare gezintisine bağlı bir kod bilmiyorum.

 

[EmrExcel16]

Alternatif olarak , benim kod da hücre seçince çalışır

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Set Rng = Range(Range("C10"), Range("J40"))
With Rng
    Rng.Interior.Pattern = xlNone
     Set c = .Find(Target, LookIn:=xlValues)
     If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            c.Interior.Color = 255
            Set c = .FindNext(c)
        If c Is Nothing Then
            GoTo DoneFinding
        End If
        Loop While c.Address <> firstAddress
      End If
DoneFinding:
End With

End Sub

 

[eseseski]

yardımlarınız için çok teşekkür ederim sayın YUSUF44 ve EmrExcel16.saygılarımla

 

[EmrExcel16]

Rica ederiz , iyi çalışmalar.

 

[YUSUF44]

Alternatif olarak , benim kod da hücre seçince çalışır

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Set Rng = Range(Range("C10"), Range("J40"))
With Rng
    Rng.Interior.Pattern = xlNone
     Set c = .Find(Target, LookIn:=xlValues)
     If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            c.Interior.Color = 255
            Set c = .FindNext(c)
        If c Is Nothing Then
            GoTo DoneFinding
        End If
        Loop While c.Address <> firstAddress
      End If
DoneFinding:
End With

End Sub

Hiç görmediğim farklı bir yöntem olmuş.

Yalnız bu kodda target belirtmediğiniz için çalışılan alan dışında hücre seçildiğinde de kodlar çalışıyor. Bir de boş hücre seçildiğinde boş hücreler de boyanıyor. Ben mi çok ayrıntıya giriyorum yoksa?

 

[EmrExcel16]

Teşekkür ederim @YUSUF44 Üstadım

Ben bu kadar ayrıntıya takılmamıştım doğrusu , ama siz söyledikten sonra tabiki düzenlemeyi yaparım bilgilendirme için teşekkür ederim.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("C10:J40")) Is Nothing Then Exit Sub
Set Rng = Range(Range("C10"), Range("J40"))
With Rng
    Rng.Interior.Pattern = xlNone
    If Target <> "" Then
        Set c = .Find(Target, LookIn:=xlValues)
        If Not c Is Nothing Then
            firstAddress = c.Address
            Do
                c.Interior.Color = 255
                Set c = .FindNext(c)
                If c Is Nothing Then
                    GoTo DoneFinding
                End If
            Loop While c.Address <> firstAddress
        End If
    End If
DoneFinding:
End With
End Sub