Soru Nöbet Çizelgesinde Hafta sonları Nöbet Vermemek

[htsumer]

Ekli dosyada nöbet çizelgesi hazırlnaıyor. Burda butona tıkladığımda Hafta sonu nöbet yok seçtiğimde Cumartesi Pazar nöbet vermiyor. Ben sadece Pazar günü nöbet vermemek istiyorum. Buna göre kodları revize etmek istedim ama yapamadım.

 

[Necdet]

Merhaba,

If Sor = vbNo And DatePart("w", CDate(Cells(i, 1)), vbMonday) > 5 Then GoTo son

Koddaki 5 rakamını 6 ile değiştirin.

 

[htsumer]

Merhaba,

If Sor = vbNo And DatePart("w", CDate(Cells(i, 1)), vbMonday) > 5 Then GoTo son

Koddaki 5 rakamını 6 ile değiştirin.

Teşekkür ederim tamamdır..

 

[htsumer]

Bu dosya üzerinde revize olarak A sütununda Tarihleri alıyor ancak hemen yanına da Günleri yazmasını istiyorum.
Örnek 01/11/205 sağ hücresine Cumartesi yazsın istiyorum. Yani her tarihin karşısına günler yazmalı..
Sütun ekliyorum ama bu seferde kodlar bozuluyor.
Birde dosyayı kapatırken şöyle bir ikaz veriyor bu nedir analamıyıorum

 

[halit3]

İlgili Sayfaya A sütunundan sonra bir sutun aklayiniz.

kod:

Sub nb1_d()
Rem HAFTA TATİLİ YOK
nb1_tarih
isatir = Cells(Rows.Count, "a").End(xlUp).Row
isatirB = Cells(Rows.Count, "B").End(xlUp).Row
Range(Cells(2, 3), Cells(isatirB, 14)).ClearContents
Set user = Range("p2:p" & [p60].End(3).Row)
    aln = user
    dgr = UBound(aln, 1)
        For i = 2 To isatir
        For j = 3 To [r2] + 2
    If dgr = 0 Then dgr = UBound(aln, 1)
            slm = Int(Rnd() * dgr + 1)
                Cells(i, j) = aln(slm, 1)
varTemp = aln(dgr, 1)
aln(dgr, 1) = aln(slm, 1)
aln(slm, 1) = varTemp
dgr = dgr - 1
        Next j
        Next i
End Sub

Sub nb1_tarih()
If [s2] = "" Or [t2] = "" Then Exit Sub
[a2:b65536].ClearContents
Ay = Array("OCAK", "ŞUBAT", "MART", "NİSAN", "MAYIS", "HAZİRAN", "TEMMUZ", "AĞUSTOS", "EYLÜL", "EKİM", "KASIM", "ARALIK")
Ay = WorksheetFunction.Match([s2], Ay, 0)
tarih = CDate("01." & Ay & "." & [Yıl])
Gün = DateSerial(Year(tarih), Month(tarih) + 1, 0)
    For x = 2 To Format(Gün, "dd") + 1
        Cells(x, "a") = Format(CDate(x - 1 & "." & Ay & "." & [Yıl]), "dd.mm.yyyy")
         Cells(x, "b") = Format(Cells(x, "a"), "dddd")
        
    Next
End Sub
Sub nb1_d_ht()
nb1_tarih
isatir = Cells(Rows.Count, "a").End(xlUp).Row
isatirB = Cells(Rows.Count, "B").End(xlUp).Row
Range(Cells(2, 3), Cells(isatirB, 14)).ClearContents
Set user = Range("p2:p" & [p60].End(3).Row)
    aln = user
    dgr = UBound(aln, 1)
Sor = MsgBox("Haftasonu çalışılıyor mu?", vbYesNo, "Haftasonu Durumu?")
        For i = 2 To isatir
        For j = 3 To [r2] + 2
If Sor = vbNo And DatePart("w", CDate(Cells(i, 1)), vbMonday) > 6 Then GoTo son
    If dgr = 0 Then dgr = UBound(aln, 1)
            slm = Int(Rnd() * dgr + 1)
                Cells(i, j) = aln(slm, 1)
varTemp = aln(dgr, 1)
aln(dgr, 1) = aln(slm, 1)
aln(slm, 1) = varTemp
dgr = dgr - 1
son:
        Next j
        Next i
End Sub

 

[htsumer]

Halit hocam çok teşekkür ederim yarın entegre edip dönüş yapacağım.