İsme tıklandığı zaman aynı isimlerin görünür olma makrosu

[akmlyx]

Değerli Üstatlarım merhaba,
Ekte bir okula ait haftalık ders programı mevcut. Bu ders programında aynı öğretmenin ders programını topluca görebilmek gerekiyor. Bunun için örneğin A2 hücresinde bulanan Cemil ismine tıkladığım zaman G2 hücresinden W40 hücre aralığındaki tüm Cemil isimlerine ait hücrelerin dolgu rengi kırmızı olmasını, boş bir hücreye tıklayınca da hücrenin dolgu rengi önceki rengine dönmesini istiyorum. Aynı şekilde diğer öğretmenlerin ismine tıklayınca da aynı isimdeki hücrelerin dolgu rengi kırmızı olsun istiyorum. Bu konuda siz değerli üstatların yardımını bekliyorum. İlgilenen arkadaşa şimdiden teşekkür ederim.

 

[RBozkurt]

Merhaba,
Sayfaya sağ tıklayın, Kod Görüntüle kısmına ekleyiniz.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim selectedValue As String
    selectedValue = Target.Value
   
    If selectedValue <> "" Then
        For Each cell In Range("A2:W40")
            If cell.Value = selectedValue Then
                cell.Interior.ColorIndex = 3
            End If
        Next cell
    Else
        Range("A2:W40").Interior.ColorIndex = xlNone
    End If
End Sub

 

[akmlyx]

RBozkurt hocam, sorum ile ilgilendiğiniz için size çok teşekkür ederim. Elinize sağlık makro çalışıyor ama boş hücreye basınca ders programının tamamı beyaza dönüyor benim istediğim mevcut hücre rengine dönmesini istiyorum. Örneğin mevcut hücre rengi yeşil ise boş hücreye basınca yine yeşil renk, mavi ise yine mavi renk olacak.

 

[Necdet]

Merhaba,
Koşullu Biçimlendirmeyi Makro ile birleştirirsek :

E1:W45 aralığına koşullu biçimlendirme uyguladım.
Formül :

=E1=$AA$1

Aşağıdaki kodları da ilgili sayfanın kod bölümüne kopyalayınız.

A sütunundaki değer seçildiğinde bu değer boş değilse AA1 hücresine yazdırılır. Siz bu hücreyi başka bir hücre ile değiştirebilirsiniz.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Selection.Count > 1 Then Exit Sub
    If Intersect(Target, [A:A]) Is Nothing Or Target.Value = "" Then Exit Sub
    Range("AA1") = Cells(Target.Row, 1)
End Sub

 

[akmlyx]

Elinize sağlık hocam, gayet güzel olmuş teşekkür ederim.