Satır-Sütun Renklendirme

[xternet]

Merhaba Arkadaşlar,

Bir konuda yardımınıza başvurmak istiyorum.
Örnek dosyadaki çalışmada göreceğiniz gibi yazılan kod gereği sayfa içerisinde tıklandığında belirli satır ve sütunlarda renk değişimi ile belirginleşme oluşuyor. Yalnız bu değişim sayfadaki her hücreye tıklandığında gerçekleşiyor.
Benim olmasını istediğim; bu değişimi sağlayan kodun sadece "F9:AK81" aralığında gerçekleşmesi.
Yani sadece bu aralıktaki hücrelere tıklandığında satır-sütun renklensin, bu alan dışında bir hücreye tıklandığında sayfada renk değişimi olmasın.

İlişkili bir başka konu; bu kodu sayfaya eklemeden önce notların yazıldığı beyaz hücrelerde koşullu biçimlendirme 44,5 in altında olan değerler kırmızı olarak görünüyordu. Ama artık yukarıdaki kod gereği bu kod iptal olmuş oldu. Bu koşulu yukarıdaki kodun içine yazarak yada daha farklı biçimde yeniden aktif hale getirebilirmiyiz.

Tüm arkadaşlara şimdiden teşekkür edeirm.
İyi çalışmalar.

 

[hamitcan]

Böyle deneyin.

 Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim Satır As Range, Sütun As Range
    If Intersect(Target, Range("F9:AK81")) Is Nothing Then Exit Sub'Bu satırı ekledim.
    Set Satır = Range(Cells(ActiveCell.Row, 5), Cells(ActiveCell.Row, 37))
    Set Sütun = Range(Cells(8, ActiveCell.Column), Cells(81, ActiveCell.Column))
    
    Cells.FormatConditions.Delete
    
    If Application.CutCopyMode = xlCopy Or Application.CutCopyMode = xlCut Then Exit Sub
    
    With Satır
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:=1
        .FormatConditions(1).Font.Bold = True
        .FormatConditions(1).Interior.ColorIndex = [C15]
    End With
    
    With Sütun
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:=1
        .FormatConditions(1).Font.Bold = True
        .FormatConditions(1).Interior.ColorIndex = [C15]
    End With
    
    With ActiveCell
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:=1
        .FormatConditions(1).Font.Bold = True
        .FormatConditions(1).Interior.ColorIndex = 2
    End With
End Sub

 

[xternet]

Teşekkürler Sayın Hamitcan, zihninize sağlık.

Yalnız eklediğiniz kod ile istediğim gerçekleşiyor fakat son seçilen hücreye göre satır-sütun renklendirmeleri kalıyordu. Bende tahmin yürüterek;

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

Cells.FormatConditions.Delete' BU SATIRI EKLEDİM (xternet)

If Intersect(Target, Range("F9:AK81")) Is Nothing Then Exit Sub'Bu satırı ekledim.
Set Satır = Range(Cells(ActiveCell.Row, 5), Cells(ActiveCell.Row, 37))
Set Sütun = Range(Cells(8, ActiveCell.Column), Cells(81, ActiveCell.Column))

Cells.FormatConditions.Delete

If Application.CutCopyMode = xlCopy Or Application.CutCopyMode = xlCut Then Exit Sub

With Satır
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, Formula1:=1
.FormatConditions(1).Font.Bold = True
.FormatConditions(1).Interior.ColorIndex = [C15]
End With

With Sütun
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, Formula1:=1
.FormatConditions(1).Font.Bold = True
.FormatConditions(1).Interior.ColorIndex = [C15]
End With

With ActiveCell
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, Formula1:=1
.FormatConditions(1).Font.Bold = True
.FormatConditions(1).Interior.ColorIndex = 2
End With
End Sub

şeklinde düzenledim ve işe yaradı.

Yalnız sorumda birde 2. kısım vardı. Acaba ona çözüm üretmek mümkün mü?
Yani bu kodla sayfadaki diğer koşullu biçimlendirmelerin etkilenmemesi yada istediğim biçimlendirmenin bu kodun içine yazılması?

 

[hamitcan]

Bu kodu da ekleyin.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Value <= 44.5 Then
    Target.Font.Color = vbRed
    Else
    Range("F9:AK81").Font.Color = vbBlack
    End If
End Sub

 

[Korhan Ayhan]

Merhaba,

Aşağıdaki kodu denermisiniz.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim Satır As Range, Sütun As Range, No_Alan As Range
 
    Cells.FormatConditions.Delete
 
    Set No_Alan = Range("H9:S68,V9:AH68")
 
    With No_Alan
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:="=VE(H9>0;H9<44,5)"
        With .FormatConditions(1).Font
            .Color = -16383844
            .TintAndShade = 0
        End With
        With .FormatConditions(1).Interior
            .PatternColorIndex = xlAutomatic
            .Color = 13551615
            .TintAndShade = 0
        End With
        .FormatConditions(1).StopIfTrue = False
    End With
    If Intersect(Target, Range("F9:AK81")) Is Nothing Then Exit Sub
 
    Set Satır = Range(Cells(ActiveCell.Row, 6), Cells(ActiveCell.Row, 37))
    Set Sütun = Range(Cells(9, ActiveCell.Column), Cells(81, ActiveCell.Column))
 
    If Application.CutCopyMode = xlCopy Or Application.CutCopyMode = xlCut Then Exit Sub
 
    With Satır
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:=1
        .FormatConditions(1).Font.Bold = True
        .FormatConditions(1).Interior.ColorIndex = [C15]
    End With
 
    With Sütun
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:=1
        .FormatConditions(1).Font.Bold = True
        .FormatConditions(1).Interior.ColorIndex = [C15]
    End With
 
    With ActiveCell
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:=1
        .FormatConditions(1).Font.Bold = True
        .FormatConditions(1).Interior.ColorIndex = 2
    End With
End Sub

 

[nane]

Teşekkürler
Hamitcan ve Korhan bey

Yb®

 

[Murat OSMA]

Alternatif olarak şu kodları deneyebilirsiniz;

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    On Error Resume Next
    Dim kirmizi As Range
    If Intersect(Target, Range("F9:AK81")) Is Nothing Then _
    Range("F9:AK81").Interior.ColorIndex = 0: Exit Sub
    Range("F9:AK81").Interior.ColorIndex = 0
    Range("renk").Interior.ColorIndex = 20
    Set satir = Range("F" & Target.Row, "AK" & Target.Row)
    Set Sütun = Range(Cells(9, Target.Column), Cells(81, Target.Column))
    Set Evn = Union(satir, Sütun)
    Evn.Interior.ColorIndex = 37
    ActiveCell.Interior.ColorIndex = 0
    For Each kirmizi In Range("H9:S68,V9:AH68")
        If kirmizi.Value < 44.5 Then
           kirmizi.Font.ColorIndex = 3
            Else
           kirmizi.Font.ColorIndex = 0
        End If
    Next kirmizi
End Sub

 

[xternet]

Tüm yanıtlar için teşekkür ederim arkadaşlar. Yalnız en çok işime yarayan Sayın Korhan Ayhan'ın çözümü. Bir tek değişmesi gereken hücre renginin kırmızı olması değilde yazı karakterinin kırmızı olması.

 

[xternet]

Tekrar merhaba arkadaşlar.
Yukarıda istediğim sonucu elde ettim belki ama şu sorumun da cevabını bulamamak beni deli etti.

Aslında bu konu başlığındaki arayışın sebebi, daha önce excel 2003'de sorunsuz çalışan koşullu biçimlendirmenin 2010'da çalışmaması. İnanın deli oldum. Örnek dosya da not listesi var.
Notlara tıklandığında satırın başındaki isim ve numara biçim değiştirerek öne çıkıyor.
Buda benim işimi görüyor. Yalnız bu dediğim 2003 de oluyor. 2010 da çalışmıyor.
Çözemedim. Merak eden arkadaşlar bir göz atarsa sevinirim.

Sayfayı incelediğinizde arka planda;

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
[BM9] = ActiveCell.Address
End Sub

kodunun çalıştığını ve BM9 hücresi ile ilişkili bir biçimlendirme olduğunu göreceksiniz.

 

[Ömer]

Tüm yanıtlar için teşekkür ederim arkadaşlar. Yalnız en çok işime yarayan Sayın Korhan Ayhan'ın çözümü. Bir tek değişmesi gereken hücre renginin kırmızı olması değilde yazı karakterinin kırmızı olması.

Merhaba,

Korhan bey'in eklediği kodlardaki, ".Color = 13551615" bu satırı pasif yapın.

'.Color = 13551615

Gibi.
--------------------------------------------------------------------------

excel 2003'de sorunsuz çalışan koşullu biçimlendirmenin 2010'da çalışmaması.

Yenileme promleminden dolayı kaynaklanıyor. Sayfadaki kodu aşağıdakiyle değiştirin.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
    Range("BM9") = ActiveCell.Address
 
    SendKeys "%^{F9}", True
 
End Sub

.

 

[xternet]

Çok teşekkürler Sayın Ömer Bey.
Ciddi bir sorunumu çözdünüz. Zihninize sağlık.

Microsoft'a 2007 ile birlikte getirdiği köklü değişikliklerden dolayı çok kızmıştım
ve hala kızmaya devam ediyorum. Her ne kadar kullanım ve görsellik anlamında
güzel değişiklikler yapmış olsada şu uyum problemleri çok can sıkıcı.

Herkese iyi çalışmalar.

 

[xternet]

Arkadaşlar yeniden merhaba,

Bu soruyu daha öncede sormuştum ama tam cevabı alamamıştım.
Yenilemem gerekirse;
Aşağıdaki kod ilgili hücrelerin şarta göre renklendirilmesini sağlıyor.
Yalnız ben hücrenin değil sadece yazı karakterinin renklenmesini istiyorum.
Nasıl bir düzenleme yapmak gerekir.
İlgilenecek arkadaşlara şimdiden teşekkür ederim.
Hayırlı sahurlar.



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

Cells.FormatConditions.Delete

Set No_Alan = Range("H9:S68,V9:AH68")

With No_Alan
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, Formula1:="=VE(H9>0;H9<44,5)"
With .FormatConditions(1).Font
.Color = -16383844
.TintAndShade = 0
End With

 

[Korhan Ayhan]

Merhaba,

Aşağıdaki kodu deneyiniz.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim No_Alan As Range
 
    ActiveSheet.Unprotect "12345"
 
    Cells.FormatConditions.Delete
 
    Set No_Alan = Range("H9:S68,V9:AH68")
 
    With No_Alan
        .FormatConditions.Add Type:=xlExpression, Formula1:="=VE(H9>0;H9<44,5)"
        .FormatConditions(.FormatConditions.Count).SetFirstPriority
        With .FormatConditions(1).Font
            .Bold = True
            .Italic = False
            .Color = -16776961
            .TintAndShade = 0
        End With
    End With
 
    ActiveSheet.Protect "12345"
End Sub

 

[xternet]

Çok teşekkür ederim Sayın Korhan Ayhan, zihninize sağlık.

İyi çalışmalar hekese...

 

[xternet]

Merhaba Arkadaşlar,
Tam işi çözdüm diyorsun başka bir şey çıkıyor.
Dün gece tamam deyip bırakmıştım ama bugün çalışmaya sayfa koruması ekleyince kod hata vermeye başladı. Bu sorunu nasıl aşabilirim!

İyi çalışmalar, iyi iftarlar ...

 

[Korhan Ayhan]

Merhaba,

Korumalı sayfalarda makrolar çalışmaz. Bu tarz detayları sorularınızı sorarken belirtmeniz gerekiyor. Ben üstteki mesajımdaki koda eklemeler yaptım. Kendinize göre düzenlersiniz.

 

[xternet]

Teşekkür ederim Sayın Korhan Ayhan.
Söylediğinizde haklısınız. Ama ayrıntılar gözden kaçabiliyor.
Yada baştan ön göremediğiniz noktalar sonradan eklenince böyle oluyor.
Tekrar çok teşekkürler. Zihninize sağlık.