Soru VBA Kodları İle Koşullu Biçimlendirme

[sametguler]

B sütununda B8:B38 arasında Pazar yazan hücre varsa, Pazar hücresinin olduğu satırın altını en kalın düz çizgi olarak A ve I satırlarına kadar çizecek şekilde kod yazabilir miyiz?
Örnek Dosya ve Örnek Resim ekte sunulmuştur.

Şimdiden teşekkür ederim.

 

[ÖmerBey]

Merhaba,
Aşağıdaki kodu deneyiniz...

Sub kod()
Range("A8:I39").Borders(xlInsideHorizontal).Weight = xlThin
For a = 8 To 38
    If Cells(a, "B") = "PAZAR" Then
        Range("A" & a & ":I" & a).Borders(xlEdgeBottom).Weight = xlThick
    End If
Next
End Sub

 

[sametguler]

Farklı Sayfalara uyarlama yapmak istiyorum. Kodu hangi alana eklemem gerekiyor?
Ancak günler değiştiğinde anlık olarak yapabilir mi.

 

[ÖmerBey]

Dosyanız ektedir...
İlgili sayfanın kod bölümüne aşağıdaki kodlar eklenmiştir.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("C4:C5")) Is Nothing Then kod
End Sub
Private Sub kod()
Application.ScreenUpdating = False
Range("A8:I39").Borders(xlInsideHorizontal).Weight = xlThin
For a = 8 To 38
    If Cells(a, "B") = "PAZAR" Then
        Range("A" & a & ":I" & a).Borders(xlEdgeBottom).Weight = xlThick
    End If
Next
Application.ScreenUpdating = True
End Sub

 

[sametguler]

Çok teşekkür ederim. Peki ekte belirttiğim dosyada ki gibi kenarlık çizgisi değilde, Cumartesi ve Pazar gün satırlarının hücre arka planını belirtilen renkte yapabilir miyiz?

 

[ÖmerBey]

Arka plan için makro yerine koşullu biçimlendirme kullanabilirsiniz.
A8:I38 aralığını seçtikten sonra koşullu biçimlendirme ekleyip formül kısmına =HAFTANINGÜNÜ($A8;2)>5 formülünü uygulayıp dilediğiniz dolgu rengi düzenlemesini yaparsınız.
Yine de makro isterseniz dosyadaki kodu aşağıdaki şekilde değiştiriniz.

Private Sub kod()
Application.ScreenUpdating = False
Range("A8:I39").Interior.ColorIndex = 0
For a = 8 To 38
    If Cells(a, "B") = "PAZAR" Or Cells(a, "B") = "CUMARTESİ" Then
        Range("A" & a & ":I" & a).Interior.ColorIndex = 15
    End If
Next
Application.ScreenUpdating = True
End Sub

 

[sametguler]

Ömer Bey Sizden Allah Razı Olsun.
Hepsi işime çok yaradı.
Bu formülleri uygulamadan önce ŞİFRESİZ SAYFA KORUMASINI kaldırıp, formülü uyguladıktan sonra TEKRAR ŞİFRESİZ SAYFA KORUMASINI AKTİF yapabilir miyiz?

 

[sametguler]

Sayın Hocam.
Aynı Kodları Aynı sayfa formatına sahip, başka sayfalara da ekledim.
Fakat bir sorunla karşılaştım. Diğer tüm sayfalarım Ay ve Yıl bilgilerini İDARİ KAT sayfasındaki Ay ve Yıl verilerinden çekiyor.
Diğer sayfalardaki Ay ve Yıl Bağ Yağıştır ile formüllü olduğundan,
Diğer sayfalarımda Pazar Günlerin olduğu satırın altı Koyu Kalın Çizgi ile çizilmiyor

 

[ÖmerBey]

Kodun başına Me.Unprotect sonuna da Me.Protect satırlarını ilave ediniz.
İyi çalışmalar...

 

[sametguler]

Sayın Hocam.
Aynı Kodları Aynı sayfa formatına sahip, başka sayfalara da ekledim.
Fakat bir sorunla karşılaştım. Diğer tüm sayfalarım Ay ve Yıl bilgilerini İDARİ KAT sayfasındaki Ay ve Yıl verilerinden çekiyor.
Diğer sayfalardaki Ay ve Yıl Bağ Yağıştır ile formüllü olduğundan,
Diğer sayfalarımda Pazar Günlerin olduğu satırın altı Koyu Kalın Çizgi ile çizilmiyor

 

[ÖmerBey]

Sayın Hocam.
Aynı Kodları Aynı sayfa formatına sahip, başka sayfalara da ekledim.
Fakat bir sorunla karşılaştım. Diğer tüm sayfalarım Ay ve Yıl bilgilerini İDARİ KAT sayfasındaki Ay ve Yıl verilerinden çekiyor.
Diğer sayfalardaki Ay ve Yıl Bağ Yağıştır ile formüllü olduğundan,
Diğer sayfalarımda Pazar Günlerin olduğu satırın altı Koyu Kalın Çizgi ile çizilmiyor

Çünkü o sayfalarda değişiklik olmadığı için kod tetiklenmiyor.
Kodu ilgili sayfalarda el ile çalıştırabilirsiniz. Otomatik tetiklenme için İDARİ KAT sayfasındaki tetikleyici kodu aşağıdaki şekilde değiştiriniz. (Kırmızı kısımlar yerine kendi dosyanızdaki sayfaların vb düzenleyicisindeki adlarını yazınız.)
Diğer sayfalara bu kodu kopyalamanıza gerek yok.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("C4:C5")) Is Nothing Then
    Application.Run "Sayfa1.kod"
    Application.Run "Sayfa2.kod"
End If
End Sub