Renklendirmede çift renk

[klop01]

Değerli forum üyeleri,

Ekteki belgemde aktif hücre satır ve sütun renklendirmesi yapan bir kod var. Kod sorunsuz çalışıyor.

Yapmak istediğim:
Bu koda bir ek yapılsa da aktif hücre ile beraber her satırda sabit bir hücreyi de renklendirse.

Ekteki belgede görselle desteklenmiş ayrıntı mevcut.

Bilgi sahibi arkadaşların yardımlarını rica ediyorum.

We Transfer: https://we.tl/ODDNol8scC

 

[askm]

Kodları aşağıdaki şekilde değiştirin.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("B5:AY66")) Is Nothing Then
    Cells.FormatConditions.Delete
    Exit Sub
End If

Dim Satır As Range, Sütun As Range
    
    Set Satır = Range(Cells(ActiveCell.Row, 2), Cells(ActiveCell.Row, 51))
    Set Sütun = Range(Cells(Target.Row, ActiveCell.Column), Cells(5, ActiveCell.Column))
    
    Cells.FormatConditions.Delete
    
    With Satır
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:=1
        .FormatConditions(1).Font.Bold = True
        .FormatConditions(1).Interior.ColorIndex = 8
    End With
    
    With Sütun
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:=1
        .FormatConditions(1).Font.Bold = True
        .FormatConditions(1).Interior.ColorIndex = 8
    End With
    
    With ActiveCell
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:=1
        .FormatConditions(1).Font.Bold = True
        .FormatConditions(1).Interior.ColorIndex = 6
    End With
    
     With Cells(ActiveCell.Row, "AN")
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:=1
        .FormatConditions(1).Font.Bold = True
        .FormatConditions(1).Interior.ColorIndex = 6
    End With
End Sub

 

[klop01]

Sayın askm,

İstenileni tam olarak yaptı gönderdiğiniz kod.

Çok teşekkür ederim, sağ olunuz.

 

[askm]

Rica ederim. Hayırlı akşamlar.

 

[klop01]

Kodu Yenileme

Değerli arkadaşlar,
Sayın askm tarafından 2. iletide verilen koda bir ekleme yaparak kodu yeniledim.
Aktif hücreye göre renklenen sütunun üstteki hücresini de sarı ile renklendirmem gerekiyor.
Birkaç deneme yaptım başarılı olamadım. Makro bilgim pek yok.
Dosya içerisinde kodun yeni hâli ve açıklama var.
Yardımlarınızı rica ederim.

YENİLENMİŞ DOSYANIN LİNKİ:
http://s3.dosya.tc/server13/q81yv8/cift_sari_renk.zip.html

 

[askm]

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("B4:BA66")) Is Nothing Then
    Cells.FormatConditions.Delete
    Exit Sub
End If

Dim Satır As Range, Sütun As Range
    
    Set Satır = Range(Cells(ActiveCell.Row, 2), Cells(ActiveCell.Row, 51))
    Set Sütun = Range(Cells(Target.Row, ActiveCell.Column), Cells(4, ActiveCell.Column))
    
    Cells.FormatConditions.Delete
    
    With Satır
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:=1
        .FormatConditions(1).Font.Bold = True
        .FormatConditions(1).Interior.ColorIndex = 8
    End With
    
    With Sütun
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:=1
        .FormatConditions(1).Font.Bold = True
        .FormatConditions(1).Interior.ColorIndex = 8
    End With
    
    With ActiveCell
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:=1
        .FormatConditions(1).Font.Bold = True
        .FormatConditions(1).Interior.ColorIndex = 6
    End With
    
     With Cells(ActiveCell.Row, "AN")
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:=1
        .FormatConditions(1).Font.Bold = True
        .FormatConditions(1).Interior.ColorIndex = 6
    End With
    
     With Cells(ActiveCell.Row, "D")
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:=1
        .FormatConditions(1).Font.Bold = True
        .FormatConditions(1).Interior.ColorIndex = 6
    End With
    
    With Cells(4, ActiveCell.Column)
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:=1
        .FormatConditions(1).Font.Bold = True
        .FormatConditions(1).Interior.ColorIndex = 6
    End With
End Sub

 

[klop01]

Sayın askm,

Kod istenileni yapıyor. Tekrar teşekkürler.
Sağ olun.

 

[askm]

Rica ederim. İyi geceler.