Sütundaki formüllerin silinmemesi.

[vuranoğlu]

Public deg1 As String
Public deg2 As String
Public Const aylar1 = "b3" 'AY
Public Const yillar1 = "b2" 'YIL

Public Sub hesapla(syf As String)
Dim M As Date, bas As Integer, J As Long
Dim yer1 As String, yillar As String, aylar As String
Const renk As Byte = 20
Const i_Sutun As Byte = 32

With ThisWorkbook.Sheets(syf)
With .Range("a5:af35")
.ClearContents
.Interior.ColorIndex = xlNone
End With
aylar = .Range(aylar1).Value
yillar = .Range(yillar1).Value

yer1 = Val(Format("01." & Format(aylar, "MM") & "." & Format(yillar, "0000"), "mm"))

Ayin_Son_Gunu = DateSerial(yillar, yer1 + 1, 1) - 1
Ayin_Ilk_Gunu = DateSerial(yillar, yer1, 1)
son = Val(Format(Ayin_Son_Gunu, "dd"))

For J = 1 To son
M = CDate(Format(J, "00") & "." & Format(aylar, "MM") & "." & Format(yillar, "0000"))
Hicri_takvim1 (M)
bas = J + 4 '5.satirdan basladigi icin
.Cells(bas, 2).Value = J
If Format(M, "DDDD") = "Pazar" Or Format(M, "DDDD") = "" Then
.Range("b" & bas & ":af" & bas).Interior.ColorIndex = renk
.Cells(bas, i_Sutun).Value = Format(M, "DDDD")
End If

If deg1 <> "" Or deg2 <> "" Then
If deg1 <> "" Then .Cells(bas, i_Sutun).Value = deg1
If deg2 <> "" Then .Cells(bas, i_Sutun).Value = deg2
.Range("b" & bas & ":af" & bas).Interior.ColorIndex = renk
End If
Next
End With
End Sub

Sub Hicri_takvim1(TRH)
deg2 = ""
If Month(TRH) = 1 And Day(TRH) = 1 Then deg2 = "Yılbaşı"
If Month(TRH) = 4 And Day(TRH) = 23 Then deg2 = "Ulusal Egemenlik Çocuk Bayramı"
If Month(TRH) = 5 And Day(TRH) = 1 Then deg2 = "İşçi Bayramı"
If Month(TRH) = 5 And Day(TRH) = 19 Then deg2 = "Gençlik ve Spor Bayramı"
If Month(TRH) = 7 And Day(TRH) = 15 Then deg2 = " 15 temmuz"
If Month(TRH) = 8 And Day(TRH) = 30 Then deg2 = "Zafer Bayramı"
If Month(TRH) = 10 And Day(TRH) = 28 Then deg2 = "Cumhuriyetin Bayramı Yarım gün"
If Month(TRH) = 10 And Day(TRH) = 29 Then deg2 = "Cumhuriyetin Bayramı"
Calendar = vbCalHijri
deg1 = ""

If Month(TRH) = 9 And Day(TRH) = 30 Then deg1 = "Ramazan Bayramı Arife.günü Yarım gün"
If Month(TRH) = 10 And Day(TRH) = 1 Then deg1 = "Ramazan Bayramı 1.günü"
If Month(TRH) = 10 And Day(TRH) = 2 Then deg1 = "Ramazan Bayramı 2.günü"
If Month(TRH) = 10 And Day(TRH) = 3 Then deg1 = "Ramazan Bayramı 3.günü"

If Month(TRH) = 12 And Day(TRH) = 10 Then deg1 = "Kurban Bayramı Arife.günü Yarım gün"
If Month(TRH) = 12 And Day(TRH) = 11 Then deg1 = "Kurban Bayramı 1.günü"
If Month(TRH) = 12 And Day(TRH) = 12 Then deg1 = "Kurban Bayramı 2.günü"
If Month(TRH) = 12 And Day(TRH) = 13 Then deg1 = "Kurban Bayramı 3.günü"
If Month(TRH) = 12 And Day(TRH) = 14 Then deg1 = "Kurban Bayramı 4.günü"

Calendar = vbCalGreg
End Sub

Merhaba
Yukarıdaki kodlar ile tabloda ay ve yıl değiştiğinde günler ve resmi tatillerdeğişiyor.
Ancak değişiklik yapıldığında toplam sütunlarındaki (Q-X-AE)formüllerde siliniyor.
Bunu nasıl düzeltebiliriz?
Teşekkürler.

 

[ÖmerFaruk]

With .Range("a5:af35")
.ClearContents

Bu satırda siliyor. Kodu yazan bilerek silmiş olmalı diye düşünüyorum.