Aya göre günleri yazıp haftasonlarını renklendirmek

[Yesilyurtlu]

Değerli üstadlarım;

Excelde her ay 5 ya da 6 kere çizelge yapmak ve hafta sonlarına denk gelen sütunları bulup renklendirme işlemini yapıyorum.

Bunun yerine bir düğmeye makro atayıp a1 aile ae31 hücreleri arasına içinde bulunulan ayı yazması ve haftasonlarına denk gelen sütunlarıda 50 kişilik satıra kadar renklendirme yapması mümkün müdür?

 

[Orion1]

Değerli üstadlarım;

Excelde her ay 5 ya da 6 kere çizelge yapmak ve hafta sonlarına denk gelen sütunları bulup renklendirme işlemini yapıyorum.

Bunun yerine bir düğmeye makro atayıp a1 aile ae31 hücreleri arasına içinde bulunulan ayı yazması ve haftasonlarına denk gelen sütunlarıda 50 kişilik satıra kadar renklendirme yapması mümkün müdür?

Mümkün.

 

[Orion1]

Koşullu biçimlendirme yapıldı.
Ekli dosyayı inceleyiniz.

 

[Yesilyurtlu]

ÜSTAD Eline sağlık;

Koşullu biçimlendirme haricinde makro ile yapılabilirse ki silinme riski enaz formül bakımından beni memnun edersiniz ÜSTADIM

Allah sizden razı olsun

 

[Orion1]

ÜSTAD Eline sağlık;

Koşullu biçimlendirme haricinde makro ile yapılabilirse ki silinme riski enaz formül bakımından beni memnun edersiniz ÜSTADIM

Allah sizden razı olsun

Dosya ektedir.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Date, ilk As Date, son As Date, sut As Byte
If Intersect(Target, [B1:B2]) Is Nothing Then Exit Sub
On Error Resume Next
ilk = DateSerial(Range("B1").Value, WorksheetFunction.Match(Range("B2").Value, Range("B11:B22"), 0), 1)
son = DateSerial(Year(ilk), Month(ilk) + 1, 0)
sut = 4
Range("D2:AH22").Interior.ColorIndex = xlNone
Range("D2:AH22").Font.ColorIndex = vbBlack
Range("D2:AH2").Font.Bold = False
For i = ilk To son
    Cells(2, sut).Value = i
    If Weekday(Cells(2, sut).Value, 2) = 7 Then
        Range(Cells(2, sut), Cells(22, sut)).Interior.Color = vbRed
        Range(Cells(2, sut), Cells(22, sut)).Font.Color = vbYellow
        Range(Cells(2, sut), Cells(22, sut)).Font.Bold = True
    End If
        sut = sut + 1
Next

End Sub

 

[Yesilyurtlu]

ÜSTADIM;
Ellerin dert görmesin inşallah

 

[Orion1]

ÜSTADIM;
Ellerin dert görmesin inşallah

Rica ederim.
İyi çalışmalar.

 

[mustafaine1]

evren hocam vba sayesinde bi 10 sene fazla yasar Cennete gidicek direk kodla

Hocam biara ufak bi vakit harcayip su konuya bakarmisin, ama vakit kaybetmeni istemem utopik olmus sanirim cevap gelmedi bu konuda bana..

 

[Yesilyurtlu]

ÜSTADIM;
Aşağıdaki koda Cumartesi gününüde eklemek mümkün mü?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Date, ilk As Date, son As Date, sut As Byte
If Intersect(Target, [B3:B4]) Is Nothing Then Exit Sub
On Error Resume Next
ilk = DateSerial(Range("B3").Value, WorksheetFunction.Match(Range("B4").Value, Range("ıv4:ıv15"), 0), 1)
son = DateSerial(Year(ilk), Month(ilk) + 1, 0)
sut = 4
Range("D5:AH50").Interior.ColorIndex = xlNone
Range("D5:AH50").Font.ColorIndex = vbBlack
Range("D5:AH50").Font.Bold = False
For i = ilk To son
Cells(5, sut).Value = i
If Weekday(Cells(5, sut).Value, 2) = 7 Then

Range(Cells(5, sut), Cells(50, sut)).Interior.Color = vbGreen
Range(Cells(5, sut), Cells(50, sut)).Font.Color = vbRed
Range(Cells(5, sut), Cells(50, sut)).Font.Bold = True
End If
sut = sut + 1
Next

End Sub