Takvimi VBA ile renklendirme

[mavi674]

Selam
Ekli dosyada bir takvim var.
Cumartesi ve Pazarları sütun olarak renklendirmek istiyorum.
Koşullu biçimlendirme ile yapıyorum ama vba ile daha kolay ve hızlı olacak ve öğrenme açısından da iyi olacak.
ben biraz uğraştım ama tam istediğim gibi olmadı eksik oldu

https://www.dosyaupload.com/27zmw/ÖRNEK_-_TAKVİM.xls

C6:AG6 satırda günler var. (Cumartesi ve Pazar)
Birde o ayın güncel günü yazıyor.
1-Cumartesi ve Pazar günlerine rastlayan hücreler
gün satırı da (6.satır) dahil olmak üzere 15 satıra kadar sütun olarak sarı olsun.
2-Bir de aktif gün de 6-15 satır arası olan sütun yeşil olsun
mesela gün bugün ayın 21 ise takvimde de 21 gün sütunu 6-15 satır arası yeşil olsun.
3-Ayın son günleri 30 veya 31 çekmesi durumlarda o sütun gri olsun.
zaten 7.satırda çekmeyen günler "-" ile belirtiliyor .
Teşekkürler...

 

[dEdE]

Merhaba,
Dener misiniz?

Private Sub Worksheet_Calculate()
    Dim My_Area As Range, Rng As Range 
    Set My_Area = Range("C6:AG15")
    My_Area.Interior.ColorIndex = xlNone

For Each Rng In My_Area
    sut = Split(Rng.Address, "$")(1)
    If Rng.Value = "CUMARTESİ" Then Range(sut & 6 & ":" & sut & 15).Interior.ColorIndex = 6
    If Rng.Value = "CUMARTESİ" Then Rng.Font.ColorIndex = 1
        
    If Rng.Value = "PAZAR" Then Range(sut & 6 & ":" & sut & 15).Interior.ColorIndex = 6
    If Rng.Value = "PAZAR" Then Rng.Font.ColorIndex = 1
        
    If Range("AK1") = Range("AM1") And Cells(7, sut) = Day(Range("D2")) Then _
        Range(sut & 6 & ":" & sut & 15).Interior.ColorIndex = 4
        
        
    If Range("AG7") = 31 Then
        Range("AG6:AG15").Interior.ColorIndex = 15
    Else
        Range("AF6:AF15").Interior.ColorIndex = 15
    End If
Next
End Sub

 

[mavi674]

idi)Süpersiniz
mükemmel olmuş
sadece ay sonları yanlış oluyor
Pardon Şubat ayını unutmamak lazım zira o da 28 çekiyor (bu yıl 29 idi)
28 veya 30 veya 31 çeken aylar sonrası 1 - 2 veya 3 sütun gri olacak
Teşekkürler

 

[dEdE]

sadece ay sonları yanlış oluyor
Pardon Şubat ayını unutmamak lazım zira o da 28 çekiyor (bu yıl 29 idi)
28 veya 30 veya 31 çeken aylar sonrası 1 - 2 veya 3 sütun gri olacak

Haklısınız,
Şubat ayı gözümden kaçmış.
Mevcut kodun

If Range("AG7") = 31 Then
        Range("AG6:AG15").Interior.ColorIndex = 15
    Else
        Range("AF6:AF15").Interior.ColorIndex = 15
End If

kısmının yerine aşağıdaki kodu yapıştırarak dener misiniz?

    For i = 33 To 30 Step -1
        If IsNumeric(Cells(7, i)) Then
            Range(Cells(6, i).Address, Range(Cells(15, 33).Address)).Interior.ColorIndex = 15
            Exit For
        End If
    Next i

 

[mavi674]

Ben de sizden örnek alarak ay sonunu çözmüştüm. "-" üzerinden yaptım. örnek ekli...
tabii ki sizinki daha daha formüle olmuş hali
Bir de ekleme yaptım
C8:AG15 arasında hücrelerde bulunan sayılaın öne çıkması için mavi olmasını istemiştim ama
6.ve 7, satırlar da tanımlandığı için o satırlar da giriyor. Benim örnekte 3 sayfada koşullu biçimlendirme ile yaptığım şekilde
2. sayfada da vba lie bunu gerçekleştirebilmek.
İlginiz için teşekkürler

ÖRNEK - TAKVİM.xls indir

Dosyayı indir, full download - ÖRNEK - TAKVİM.xls

www.dosyaupload.com

 

[mavi674]

For i = 33 To 30 Step -1
If IsNumeric(Cells(7, i)) Then
Range(Cells(6, i).Address, Range(Cells(15, 33).Address)).Interior.ColorIndex = 15
Exit For
End If
Next i


Bulunduğu ay'ın son gününü de da gri yapıyor
ay 30 çekiyorsa 30 da dahil gri,
31 çekiyorsa 31 da dahil gri,
28 çekiyorsa 289 da dahil son sütunlarda gri oluyor...

 

[dEdE]

#3 no.lu mesajınızda "...28 veya 30 veya 31 çeken aylar sonrası 1 - 2 veya 3 sütun gri olacak ..." demiştiniz.
Eğer sadece ayın son gününün gri olmasını istiyorsanız, koddaki 33 sayısını i harfi ile değiştirmeniz yeterli olacaktır.

 

[mavi674]

hayır hayır 3 mesajımdaki isteğim geçerlidir.
Zaten ben de son gönderdiğim örnekte 3 sayfada yaptığım gibi olacak
bu şekilde kalabilir.
C8:AG15 arasında hücrelerde bulunan sayıların mavi olması yeterlidir.
Sayenizde çok şey öğrendim eklemeler yapmayı başardım.
sağ olun
var olun...

 

[dEdE]

Private Sub Worksheet_Calculate()
    Dim My_Area As Range, Rng As Range
    Set My_Area = Range("C6:AG15")
    My_Area.Interior.ColorIndex = xlNone

For Each Rng In My_Area
    sut = Split(Rng.Address, "$")(1)
    If Rng.Value = "CUMARTESİ" Then Range(sut & 6 & ":" & sut & 15).Interior.ColorIndex = 6
    If Rng.Value = "CUMARTESİ" Then Rng.Font.ColorIndex = 1
        
    If Rng.Value = "PAZAR" Then Range(sut & 6 & ":" & sut & 15).Interior.ColorIndex = 6
    If Rng.Value = "PAZAR" Then Rng.Font.ColorIndex = 1
        
    If Range("AK1") = Range("AM1") And Cells(7, sut) = Day(Range("D2")) Then _
        Range(sut & 6 & ":" & sut & 15).Interior.ColorIndex = 4
    
    sat = Split(Rng.Address, "$")(2)
    If sat > 7 And Rng.Value <> "" Then Rng.Interior.ColorIndex = 28
        
    For i = 33 To 30 Step -1
        If IsNumeric(Cells(7, i)) Then
            Range(Cells(6, i).Address, Range(Cells(15, 33).Address)).Interior.ColorIndex = 15
            Exit For
        End If
    Next i
Next
End Sub

 

[mavi674]

çok süper
elinize sağlık
rakamların renklenmesinde 0 'larda da renkleniyor.
Sıfırlarda renklenmese iyi olacak
uğraşıyorum ama çözemedim.

 

[mavi674]

If sat > 7 And Rng.Value <> 0 Then Rng.Interior.ColorIndex = 28

bu şekilde oldu.
Teşekkürler