Koşullu biçimlendirme ile renklendirileni makro ile toplama

[ynmcan]

Merhaba arkadaşlar;

Forumdan alıp çalışmama entegre etiğim kodlar ile hafta sonlarını, resmi tatil ve dini bayramları koşullu biçimlendirme ile renklendirdiğim çizelgemde makro ile hesaplama yapmak istiyorum.

Detaylı açıklamayı ekteki dosyada yaptım.

Yardımcı olursanız sevinirim

 

[ynmcan]

Koşullu biçimlendirme ile yaptığım reklendirme makro ile yapılabilirse
saydırma ve toplama işlemi için gerkli olan makroyu ben hallederim.

 

[askm]

Aşağıdaki kodları deneyin. (Öncelikle koşullu biçimlendirmeleri iptal edin.)

Private Sub CommandButton2_Click()
Dim aylar, hucre, zaman, yer2, sec, sat3, sut3, i, j, sat1, sat, sut
 Dim c As Range
 Range(Cells(26, 12), Cells(39, 42)).Interior.ColorIndex = xlNone
CommandButton3_Click
Sheets(ActiveSheet.Name).Range("K16:K235").ClearContents

sat = 26
sut = 12
sat1 = 6
aylar = Worksheets(ActiveSheet.Name).Cells(1, 1).Value
Range("C4:AG5").ClearContents

Sheets(ActiveSheet.Name).Range("L16:AP36").ClearContents

hucre = Val(Worksheets(ActiveSheet.Name).Cells(1, 2).Value)
zaman = CDate(Format("01.01." & hucre, "dd.mm.yyyy"))
yer2 = Val(hucre - Val(Val(hucre / 4) * 4))
sec = 0
If yer2 = 0 Then
sec = 1
End If


Dim M As Date
For i = 0 To 364 + sec
M = zaman + i
Hicri_takvim1 (M)


If Format((M), "mmmm") = Worksheets(ActiveSheet.Name).Cells(1, 1).Value Then
Cells(sat, sut) = (M)


    Set c = Worksheets(ActiveSheet.Name).Range("a6:a25").Find(Cells(26, sut), LookIn:=xlValues, LookAt:=xlWhole)
    If Not c Is Nothing Then
        Range(Cells(sat, sut), Cells(sat + 13, sut)).Interior.ColorIndex = 6
    End If
    

Cells(sat + 1, sut) = Format((M), "dddd")


If Format((M), "dddd") = "Pazar" Or Format((M), "dddd") = "Cumartesi" Then

Range(Cells(sat, sut), Cells(sat + 13, sut)).Interior.ColorIndex = 3
Cells(sat1, 2).Value = (M)
sat1 = sat1 + 1

End If
sut = sut + 1
End If
Next i

deg1 = ""
MsgBox "işlem tamam"



End Sub
[code]

 

[Zeki Gürsoy]

Merhaba;

Koşullu biçimli hücrenin rengini aşağıdaki gibi öğrenebilirsiniz.

MsgBox Range("a1").DisplayFormat.Interior.ColorIndex

 

[ynmcan]

Zeki Gürsoy ve Askm her iki kod da istediğim işlevi yapıyor.
Yardımlarınız için teşekkür ederim.

Askm yolladığınız kod daki kırmızı ile belirtiğim satırlar hata veriyordu. Bu satırları sildim. Kod bu haliyle düzgün şekilde çalışıyor.

Private Sub CommandButton2_Click()
Dim aylar, hucre, zaman, yer2, sec, sat3, sut3, i, j, sat1, sat, sut
Dim c As Range
Range(Cells(26, 12), Cells(39, 42)).Interior.ColorIndex = xlNone
CommandButton3_Click
[COLOR="Red"]Sheets(ActiveSheet.Name).Range("K16:K235").ClearComments[/COLOR]

sat = 26
sut = 12
sat1 = 6
aylar = Worksheets(ActiveSheet.Name).Cells(1, 1).Value
[COLOR="red"]Range("C4:AG5").ClearContents[/COLOR]

[COLOR="red"]Sheets(ActiveSheet.Name).Range("L16:AP36").ClearComments[/COLOR]

hucre = Val(Worksheets(ActiveSheet.Name).Cells(1, 2).Value)
zaman = CDate(Format("01.01." & hucre, "dd.mm.yyyy"))
yer2 = Val(hucre - Val(Val(hucre / 4) * 4))
sec = 0
If yer2 = 0 Then
sec = 1
End If


Dim M As Date
For i = 0 To 364 + sec
M = zaman + i
Hicri_takvim1 (M)


If Format((M), "mmmm") = Worksheets(ActiveSheet.Name).Cells(1, 1).Value Then
Cells(sat, sut) = (M)


Set c = Worksheets(ActiveSheet.Name).Range("a6:a25").Find( Cells(26, sut), LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
Range(Cells(sat, sut), Cells(sat + 13, sut)).Interior.ColorIndex = 6
End If


Cells(sat + 1, sut) = Format((M), "dddd")


If Format((M), "dddd") = "Pazar" Or Format((M), "dddd") = "Cumartesi" Then

Range(Cells(sat, sut), Cells(sat + 13, sut)).Interior.ColorIndex = 3
Cells(sat1, 2).Value = (M)
sat1 = sat1 + 1

End If
sut = sut + 1
End If
Next i

deg1 = ""
MsgBox "işlem tamam"



End Sub

 

[askm]

Belirttiğiniz kısımların hata vermesi. Ya birleştirilmiş hücre olmasından ya da üzerinde şekiller olduğundan dolayı. Örnekde yolladığınız şekilleri sağ tarafa ya da başka bir sayfaya alıp deneyin.