OTOMATİK HÜCRE RENKLENDİRME

[excelience]

Merhaba arkadaşlar formumuz yenilenmiş hepimize hayırlı olsun umarım yenileneli bir kaç gün olmuştur uzun sayılacak kadardır forumdan uzaktım. Neyse
basit bir sorunum var .Sayfa 1 de yıl ve ayı seçtikten sonra renklenen hücrelerin diğer sayflarda da denk düşecek şekilde renklenmesi örnek dosya ekte mevcuttur.Emeği geçen herkese teşekkürler

 

[Ömer]

Merhaba,

Sayfa1 A2:G6:

=HAFTANINGÜNÜ(A2&"."&$D$1&"."&$A$1;2)=7

Sayfa2 ve Sayfa3 A1:AE1:

=HAFTANINGÜNÜ(A1&"."&Sayfa1!$D$1&"."&Sayfa1!$A$1;2)=7

Aralıklarına koşullu biçimlendirme için yukarıdaki formülleri yazarak deneyin.

.

 

[askm]

Veri Sayfasındaki ayların yanına 1 den 12 ye kadar rakam yazın. Yani ayın sayısal ifadesi.
Sayfa1 de H1 sütununa DÜŞEYARA(D1;VERİ!B112;2;0) formülünü yazarak seçilen ayın rakamsal değerini alın. Makro yardımı ile yapmak için aşağıdaki kodları bir butona ekleyin.

Sub askm()
Dim s1 As Worksheet
Dim s2 As Worksheet
Dim s3 As Worksheet
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
Set s3 = Sheets("Sayfa3")
Application.ScreenUpdating = False
yil = s1.Cells(1, 1)
ay = s1.Cells(1, "H")
s1.Cells.Interior.Color = xlNone
s2.Cells.Interior.Color = xlNone
s3.Cells.Interior.Color = xlNone
For x = 2 To 6
    For y = 1 To 7
        gün = s1.Cells(x, y)
        tarih = DateSerial(yil, ay, gün)
        tatil = Weekday(tarih, 1)
        If tatil = 1 Then
            s1.Cells(x, y).Interior.Color = vbYellow
        End If
    Next y
Next x
For i = 1 To 31
    tatil2 = Weekday(DateSerial(yil, ay, s2.Cells(1, i)), 1)
    If tatil2 = 1 Then
        s2.Cells(1, i).Interior.Color = vbYellow
        s3.Cells(1, i).Interior.Color = vbYellow
    End If
Next i
Application.ScreenUpdating = True
MsgBox "İşlem tamam...", vbInformation, "ASKM"
End Sub

 

[excelience]

Emeği geçen herkese çok teşekkür ederim

 

[excelience]

Veri Sayfasındaki ayların yanına 1 den 12 ye kadar rakam yazın. Yani ayın sayısal ifadesi.
Sayfa1 de H1 sütununa DÜŞEYARA(D1;VERİ!B112;2;0) formülünü yazarak seçilen ayın rakamsal değerini alın. Makro yardımı ile yapmak için aşağıdaki kodları bir butona ekleyin.

Sub askm()
Dim s1 As Worksheet
Dim s2 As Worksheet
Dim s3 As Worksheet
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
Set s3 = Sheets("Sayfa3")
Application.ScreenUpdating = False
yil = s1.Cells(1, 1)
ay = s1.Cells(1, "H")
s1.Cells.Interior.Color = xlNone
s2.Cells.Interior.Color = xlNone
s3.Cells.Interior.Color = xlNone
For x = 2 To 6
    For y = 1 To 7
        gün = s1.Cells(x, y)
        tarih = DateSerial(yil, ay, gün)
        tatil = Weekday(tarih, 1)
        If tatil = 1 Then
            s1.Cells(x, y).Interior.Color = vbYellow
        End If
    Next y
Next x
For i = 1 To 31
    tatil2 = Weekday(DateSerial(yil, ay, s2.Cells(1, i)), 1)
    If tatil2 = 1 Then
        s2.Cells(1, i).Interior.Color = vbYellow
        s3.Cells(1, i).Interior.Color = vbYellow
    End If
Next i
Application.ScreenUpdating = True
MsgBox "İşlem tamam...", vbInformation, "ASKM"
End Sub

Merhaba hocam formülünüz için teşekkür ederim fakat dikkatimi birşey çekti makroyu çalıştırırken haziran 30 gün olmasına rağmen gün sabit bir şekilde 31 olarak kalıyor şubatta vs. de aynı şekilde.Birde örneğin haziran 30 gün olmasına rağmen 31 gün görünüyor ve 31.gün de normal şartlarda haziran 31 gün olmuş olsa pazar olacağı için o da renk alıyor.Ben formülünüzü uyarladım size zahmet bir göz atarsanız çok sevinirim.Şimdiden teşekkürler