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.

 

[Necdet]

Tarihleri gün adlarını içerir şekilde biçimlendirseniz, tek sütunda işiniz çözülmüş olur. Gün adları için ayrı bir sütuna ne gerek var? anlamadım.

 

[htsumer]

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" & [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" & [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

Harika hocam eline sağlık. Çok teşekkürler.

Tarihleri gün adlarını içerir şekilde biçimlendirseniz, tek sütunda işiniz çözülmüş olur. Gün adları için ayrı bir sütuna ne gerek var? anlamadım.

Hocam istenilen format bu şekilde olduğu için aksi halde biçimlendirmede oluyor. Teşekkürler.

 

[htsumer]

@halit3 hocam 30 çeken aylarda da atama yapıyor. Bunu da düzenleyebilirmiyiz?



Birde aynı kişiye alt alta 2 nöbet denk geliyor. Böyle olmaması lazım