Kod konusunda küçük bir yardım

[klop01]

Arkadaşlar,
Excel.web.tr’den bulduğum aktif hücre renklendirmesi işlevini yapan bir kodum var. Buradaki kod satır ve sütunların sonuna kadar renklendirme yapıyor.
1. Bu kod belli sınırlar içerisinde renklendirme yapar hale getirilebilir mi?
Sınırlar B3 ile AO64 arasında olmalı.

2. Kod, satır ve sütunların kesiştiği noktadan aşağıya da devam ediyor. Yani + şeklinde oluyor. Bu kodu ┴ şeklinde kestiği noktadan aşağısını göstermeyecek şekilde oluşturabilir miyiz?

3. Gönderdiğim sayfadaki kod üzerinde çalışma yaptım ama bilgim sınırlı. İmleç çizgili alanın içerisinde iken istediğim sınırlarda oluyor fakat çizili alanın dışın tıklayınca orayı da renklendiriyor(Ekte gösterdim.).

Dosyamı ekledim. YARDIMLARINIZI RİCA EDİYORUM.


BAHSETTİĞİM KOD:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Satır As Range, Sütun As Range

Set Satır = Range(Cells(ActiveCell.Row, 2), Cells(ActiveCell.Row, 41))
Set Sütun = Range(Cells(3, ActiveCell.Column), Cells(65, 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
End Sub

WeTransfer: https://we.tl/YLP3478d4H

 

[mbasaranyt]

Kodların Başına
If Intersect(Target, [B4:AI65]) Is Nothing Then Exit Sub
ekleyip deneyin

 

[systran]

E5:AO64 aralığı için

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
[COLOR="Red"][B]If Intersect(Target, Range("E5:AO64")) Is Nothing Then
    Cells.FormatConditions.Delete
    Exit Sub
End If
[/B][/COLOR]
Dim Satır As Range, Sütun As Range
    
    Set Satır = Range(Cells(ActiveCell.Row, 2), Cells(ActiveCell.Row, 41))
    Set Sütun = Range(Cells(3, ActiveCell.Column), Cells([COLOR="Red"][B]Activecell.row[/B][/COLOR], 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
End Sub

 

[klop01]

systran,

Kod sınırlarda çalışıyor ama kestiği yerden aşağısını da renklendiriyor.
Kesişim noktasından aşağısını renklendirmemesi için ne yapmalıyız?

 

[systran]

kodu tekrar kontrol edin, ilave kırmızı yer

 

[klop01]

kodu tekrar kontrol edin, ilave kırmızı yer

Çok teşekkür ederim. Tam istediğim gibi oldu.

 

[klop01]

kodların başına
ıf ıntersect(target, [b4:aı65]) ıs nothing then exit sub
ekleyip deneyin

teşekkür ederim.

 

[vardar07]

İlgili satırı değiştirip denermisiniz.

Set Sütun = Range(Cells(Target.Row, ActiveCell.Column), Cells(3, ActiveCell.Column))

 

[klop01]

İlgili satırı değiştirip denermisiniz.

Set Sütun = Range(Cells(Target.Row, ActiveCell.Column), Cells(3, ActiveCell.Column))

Teşekkür ederim. Sizin(vardar07) yazdığınız da oluyor üstte systran'ın yazdığı da.