• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Renklendirmede çift renk

  • Konbuyu başlatan Konbuyu başlatan klop01
  • Başlangıç tarihi Başlangıç tarihi

klop01

Altın Üye
Katılım
19 Aralık 2016
Mesajlar
661
Excel Vers. ve Dili
2021 Türkçe 64 Bit
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
 

Ekli dosyalar

Kodları aşağıdaki şekilde değiştirin.
Kod:
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
 
Sayın askm,

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

Çok teşekkür ederim, sağ olunuz.
 
Rica ederim. Hayırlı akşamlar.
 
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
 

Ekli dosyalar

Kod:
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
 
Sayın askm,

Kod istenileni yapıyor. Tekrar teşekkürler.
Sağ olun.
 
Rica ederim. İyi geceler.
 
Geri
Üst