Sadece Pazarları Koduna Cumartesi Pazarları ekleme

[yanginci34]

Merhaba arkadaşlar;
Aşağıdaki fonksiyon kodu ile yıllık izini tarihi ile izin günü arasında resmi tatil ve pazar günlerini çıkararak izin bitiş tarihini hesaplıyordum fakat ilave olarak cumartesi günlerini de çıkarmak istiyorum.
(Aşağıdaki kodu bu forumda kim olduğunu hatırlayamadığım bir üstattan aldım teşekkürlerimi sunuyorum)

Dim deg1 As String
Dim deg2 As String

Function izin_bitistar(izin_tarihi, izin_günü)
If izin_tarihi <> "" Then
If izin_günü <> "" Then
sat = 0
baslangic = CDate(izin_tarihi)
Dim M As Date
For i = 0 To 365
M = CDate(Format(baslangic + i, "dd.mm.yyyy"))
Hicri_takvim1 (M)
If deg2 = "" And deg1 = "" Then
If Format(CDate(baslangic) + i, "dddd") <> "Pazar" Then
sat = sat + 1
If sat = izin_günü Then
izin_bitistar = CDate(baslangic) + i
Exit For
End If
End If
End If
Next i

Else
izin_bitistar = ""
End If
Else
izin_bitistar = ""
End If
End Function

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 = "Demokrasi ve Direnme Hakkı Günü "
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) = 9 Then deg1 = "Kurban Bayramı Arife.günü Yarım gün"
If Month(TRH) = 12 And Day(TRH) = 10 Then deg1 = "Kurban Bayramı 1.günü"
If Month(TRH) = 12 And Day(TRH) = 11 Then deg1 = "Kurban Bayramı 2.günü"
If Month(TRH) = 12 And Day(TRH) = 12 Then deg1 = "Kurban Bayramı 3.günü"
If Month(TRH) = 12 And Day(TRH) = 13 Then deg1 = "Kurban Bayramı 4.günü"
Calendar = vbCalGreg 'Miladi Takvim. PC deki

End Sub

 

[dEdE]

Merhaba,
Aşağıdaki şekilde dener misiniz?

Function izin_bitistar(izin_tarihi, izin_günü)
If izin_tarihi <> "" Then
    If izin_günü <> "" Then
        sat = 0
        baslangic = CDate(izin_tarihi)
        Dim M As Date
        For i = 0 To 365
            M = CDate(Format(baslangic + i, "dd.mm.yyyy"))
            Hicri_takvim1 (M)
                If deg2 = "" And deg1 = "" Then
                    If Format(CDate(baslangic) + i, "dddd") <> "Pazar" Then
                        If Format(CDate(baslangic) + i, "dddd") <> "Cumartesi" Then
                            sat = sat + 1
                                If sat = izin_günü Then
                                    izin_bitistar = CDate(baslangic) + i
                                    Exit For
                                End If
                        End If
                    End If
                End If
        Next i
Else
    izin_bitistar = ""
    End If
Else
    izin_bitistar = ""
End If
End Function

 

[yanginci34]

Merhaba,
Aşağıdaki şekilde dener misiniz?

Function izin_bitistar(izin_tarihi, izin_günü)
If izin_tarihi <> "" Then
    If izin_günü <> "" Then
        sat = 0
        baslangic = CDate(izin_tarihi)
        Dim M As Date
        For i = 0 To 365
            M = CDate(Format(baslangic + i, "dd.mm.yyyy"))
            Hicri_takvim1 (M)
                If deg2 = "" And deg1 = "" Then
                    If Format(CDate(baslangic) + i, "dddd") <> "Pazar" Then
                        If Format(CDate(baslangic) + i, "dddd") <> "Cumartesi" Then
                            sat = sat + 1
                                If sat = izin_günü Then
                                    izin_bitistar = CDate(baslangic) + i
                                    Exit For
                                End If
                        End If
                    End If
                End If
        Next i
Else
    izin_bitistar = ""
    End If
Else
    izin_bitistar = ""
End If
End Function

Çok teşekkürler hocam iyi günler...