16 Kişilik vardiya planı hk.

Garuramon

Garuramon

Katılım
2 Aralık 2013
Mesajlar
401
Excel Vers. ve Dili
Microsoft Office Standard 2013-Türkçe
Altın Üyelik Bitiş Tarihi
22-10-2022
:yardim:Merhaba Arkadaşlar,

EK' li dosyada görüldüğü üzere 16 kişilik vardiya planına ihtiyacım var.

Şartlar:

1- A personeli sadece gündüz çalışır ve pazar günleri çalışmaz
2-M personeli sadece gündüz, 4 gün gündüz 2 gün izin şeklinde çalışır.
3-Diğer personeller 2 gün gündüz, 2 gün gece, 2 izin şeklinde çalışır.
4-B, F, İ personellerine Vardiya Amiri olması nedeniyle aynı günler nöbet yazılmaz.
5-A personeli hariç diğer personeller izin günlerinin dışında ayda 1 gün ekstra izin kullanacak.

Örneklendirirsek;

30 gün çeken aylarda personel 2 gün gündüz, 2 gün gece, 2 izin sisteminde çalıştığı vakit ayda 20 gün çalışır 10 gün izin kullanır.
her bir çalışma günü 12 saattir ancak yemek molası (yarım saat) ve ara dinlenmeler(15 er dakika 2 defa ) çıktıktan sonra 12-1=11 saat dikkate alınır.
11 saat ile ayda çalışmış olduğu günler çarpıldığında

20x11=220 saat eder

30 gün çeken aylarda iş kanuna göre personel aylık 195 saat' den fazla çalıştırılsa mesai verilmek zorunda olunması nedeni ile mesai saatini dengelemek adına ayda 1 gün ekstra izin verilir 19x11=209 saat 209-195=14 saat aylık fazla mesai yapmış olur.

Yukarıda belirtiğim çalışma dikkate alınarak yapmak isteğim çalışma;

Ayın;
14 günü ( gündüz 6 kişi, gece 5 kişi çalışma )
16 günü ( gündüz 5 kişi,gece 5 kişi çalışma )

Yardımcı olabilir misiniz. :yardim:
 

Ekli dosyalar

Son düzenleme:
YUSUF44

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Saat hesabı ve ekstra aylık izin dışındaki istekleriniz için aşağıdaki kodu bir modüle kopyalayıp deneyiniz:

Kod: 
Sub vardiya()
[F14:AJ29] = ""
For kişi = 14 To 29
    If Cells(kişi, "D") = "A" Then
        For gün = 6 To 36
            If Cells(13, gün) <> "" Then
                If WorksheetFunction.Weekday(Cells(13, gün), 2) <> 7 Then
                    Cells(kişi, gün) = 3
                Else
                    Cells(kişi, gün) = "HT"
                End If
            End If
        Next
    ElseIf Cells(kişi, "D") = "M" Then
        For gün = 6 To 36 Step 6
            If Cells(13, gün) <> "" Then Cells(kişi, gün) = 1
            If Cells(13, gün + 1) <> "" Then Cells(kişi, gün + 1) = 1
            If Cells(13, gün + 2) <> "" Then Cells(kişi, gün + 2) = 1
            If Cells(13, gün + 3) <> "" Then Cells(kişi, gün + 3) = 1
            If Cells(13, gün + 4) <> "" Then Cells(kişi, gün + 4) = "HT"
            If Cells(13, gün + 5) <> "" Then Cells(kişi, gün + 5) = "HT"
        Next
    ElseIf Cells(kişi, "D") <> "B" And Cells(kişi, "D") <> "F" And Cells(kişi, "D") <> "İ" Then
        For gün = 6 To 36 Step 6
            If kişi Mod 3 = 0 Then
                If Cells(13, gün) <> "" Then Cells(kişi, gün) = 1
                If Cells(13, gün + 1) <> "" Then Cells(kişi, gün + 1) = 1
                If Cells(13, gün + 2) <> "" Then Cells(kişi, gün + 2) = 2
                If Cells(13, gün + 3) <> "" Then Cells(kişi, gün + 3) = 2
                If Cells(13, gün + 4) <> "" Then Cells(kişi, gün + 4) = "HT"
                If Cells(13, gün + 5) <> "" Then Cells(kişi, gün + 5) = "HT"
            ElseIf kişi Mod 3 = 1 Then
                If Cells(13, gün) <> "" Then Cells(kişi, gün) = 2
                If Cells(13, gün + 1) <> "" Then Cells(kişi, gün + 1) = 2
                If Cells(13, gün + 2) <> "" Then Cells(kişi, gün + 2) = "HT"
                If Cells(13, gün + 3) <> "" Then Cells(kişi, gün + 3) = "HT"
                If Cells(13, gün + 4) <> "" Then Cells(kişi, gün + 4) = 1
                If Cells(13, gün + 5) <> "" Then Cells(kişi, gün + 5) = 1
            ElseIf kişi Mod 3 = 2 Then
                If Cells(13, gün) <> "" Then Cells(kişi, gün) = "HT"
                If Cells(13, gün + 1) <> "" Then Cells(kişi, gün + 1) = "HT"
                If Cells(13, gün + 2) <> "" Then Cells(kişi, gün + 2) = 1
                If Cells(13, gün + 3) <> "" Then Cells(kişi, gün + 3) = 1
                If Cells(13, gün + 4) <> "" Then Cells(kişi, gün + 4) = 2
                If Cells(13, gün + 5) <> "" Then Cells(kişi, gün + 5) = 2
            End If
        Next
    Else
        For gün = 6 To 36 Step 6
            If gün Mod 3 = 0 Then
                If Cells(kişi, "D") = "B" Then
                    If Cells(13, gün) <> "" Then Cells(kişi, gün) = 1
                    If Cells(13, gün + 1) <> "" Then Cells(kişi, gün + 1) = 1
                    If Cells(13, gün + 2) <> "" Then Cells(kişi, gün + 2) = 2
                    If Cells(13, gün + 3) <> "" Then Cells(kişi, gün + 3) = 2
                    If Cells(13, gün + 4) <> "" Then Cells(kişi, gün + 4) = "HT"
                    If Cells(13, gün + 5) <> "" Then Cells(kişi, gün + 5) = "HT"
                ElseIf Cells(kişi, "D") = "F" Then
                    If Cells(13, gün) <> "" Then Cells(kişi, gün) = 2
                    If Cells(13, gün + 1) <> "" Then Cells(kişi, gün + 1) = 2
                    If Cells(13, gün + 2) <> "" Then Cells(kişi, gün + 2) = "HT"
                    If Cells(13, gün + 3) <> "" Then Cells(kişi, gün + 3) = "HT"
                    If Cells(13, gün + 4) <> "" Then Cells(kişi, gün + 4) = 1
                    If Cells(13, gün + 5) <> "" Then Cells(kişi, gün + 5) = 1
                ElseIf Cells(kişi, "D") = "İ" Then
                    If Cells(13, gün) <> "" Then Cells(kişi, gün) = "HT"
                    If Cells(13, gün + 1) <> "" Then Cells(kişi, gün + 1) = "HT"
                    If Cells(13, gün + 2) <> "" Then Cells(kişi, gün + 2) = 1
                    If Cells(13, gün + 3) <> "" Then Cells(kişi, gün + 3) = 1
                    If Cells(13, gün + 4) <> "" Then Cells(kişi, gün + 4) = 2
                    If Cells(13, gün + 5) <> "" Then Cells(kişi, gün + 5) = 2
                End If
            ElseIf gün Mod 3 = 1 Then
                If Cells(kişi, "D") = "B" Then
                    If Cells(13, gün) <> "" Then Cells(kişi, gün) = 2
                    If Cells(13, gün + 1) <> "" Then Cells(kişi, gün + 1) = 2
                    If Cells(13, gün + 2) <> "" Then Cells(kişi, gün + 2) = "HT"
                    If Cells(13, gün + 3) <> "" Then Cells(kişi, gün + 3) = "HT"
                    If Cells(13, gün + 4) <> "" Then Cells(kişi, gün + 4) = 1
                    If Cells(13, gün + 5) <> "" Then Cells(kişi, gün + 5) = 1
                ElseIf Cells(kişi, "D") = "F" Then
                    If Cells(13, gün) <> "" Then Cells(kişi, gün) = "HT"
                    If Cells(13, gün + 1) <> "" Then Cells(kişi, gün + 1) = "HT"
                    If Cells(13, gün + 2) <> "" Then Cells(kişi, gün + 2) = 1
                    If Cells(13, gün + 3) <> "" Then Cells(kişi, gün + 3) = 1
                    If Cells(13, gün + 4) <> "" Then Cells(kişi, gün + 4) = 2
                    If Cells(13, gün + 5) <> "" Then Cells(kişi, gün + 5) = 2
                ElseIf Cells(kişi, "D") = "İ" Then
                    If Cells(13, gün) <> "" Then Cells(kişi, gün) = 1
                    If Cells(13, gün + 1) <> "" Then Cells(kişi, gün + 1) = 1
                    If Cells(13, gün + 2) <> "" Then Cells(kişi, gün + 2) = 2
                    If Cells(13, gün + 3) <> "" Then Cells(kişi, gün + 3) = 2
                    If Cells(13, gün + 4) <> "" Then Cells(kişi, gün + 4) = "HT"
                    If Cells(13, gün + 5) <> "" Then Cells(kişi, gün + 5) = "HT"
                End If
            ElseIf gün Mod 3 = 2 Then
                If Cells(kişi, "D") = "B" Then
                    If Cells(13, gün) <> "" Then Cells(kişi, gün) = "HT"
                    If Cells(13, gün + 1) <> "" Then Cells(kişi, gün + 1) = "HT"
                    If Cells(13, gün + 2) <> "" Then Cells(kişi, gün + 2) = 1
                    If Cells(13, gün + 3) <> "" Then Cells(kişi, gün + 3) = 1
                    If Cells(13, gün + 4) <> "" Then Cells(kişi, gün + 4) = 2
                    If Cells(13, gün + 5) <> "" Then Cells(kişi, gün + 5) = 2
                ElseIf Cells(kişi, "D") = "F" Then
                    If Cells(13, gün) <> "" Then Cells(kişi, gün) = 1
                    If Cells(13, gün + 1) <> "" Then Cells(kişi, gün + 1) = 1
                    If Cells(13, gün + 2) <> "" Then Cells(kişi, gün + 2) = 2
                    If Cells(13, gün + 3) <> "" Then Cells(kişi, gün + 3) = 2
                    If Cells(13, gün + 4) <> "" Then Cells(kişi, gün + 4) = "HT"
                    If Cells(13, gün + 5) <> "" Then Cells(kişi, gün + 5) = "HT"
                ElseIf Cells(kişi, "D") = "İ" Then
                    If Cells(13, gün) <> "" Then Cells(kişi, gün) = 2
                    If Cells(13, gün + 1) <> "" Then Cells(kişi, gün + 1) = 2
                    If Cells(13, gün + 2) <> "" Then Cells(kişi, gün + 2) = "HT"
                    If Cells(13, gün + 3) <> "" Then Cells(kişi, gün + 3) = "HT"
                    If Cells(13, gün + 4) <> "" Then Cells(kişi, gün + 4) = 1
                    If Cells(13, gün + 5) <> "" Then Cells(kişi, gün + 5) = 1
                End If
            End If
        Next
    End If
Next
End Sub
 
Garuramon

Garuramon

Katılım
2 Aralık 2013
Mesajlar
401
Excel Vers. ve Dili
Microsoft Office Standard 2013-Türkçe
Altın Üyelik Bitiş Tarihi
22-10-2022
Yusuf Bey Merhaba,

Kusura bakmayın biraz teknoloji özürlüyüm.Modül eklemeyi tam olarak bilmiyorum örnek dosyada uygun yere ekler misiniz, yada bana öğretir misiniz.
 
Garuramon

Garuramon

Katılım
2 Aralık 2013
Mesajlar
401
Excel Vers. ve Dili
Microsoft Office Standard 2013-Türkçe
Altın Üyelik Bitiş Tarihi
22-10-2022
Garuramon' Alıntı:
Yusuf Bey Merhaba,

Kusura bakmayın biraz teknoloji özürlüyüm.Modül eklemeyi tam olarak bilmiyorum örnek dosyada uygun yere ekler misiniz, yada bana öğretir misiniz.
Genişletmek için tıkla ...
Yusuf Bey,

Formda eski konuları karıştırdım ve nasıl yapılacağını öğrendim.Kodda benim gördüğüm bir kaç sorun var desteğinizi rica ediyorum.

1-A personeli ayın tamamı gündüz çalışacak ancak pazar günü çalışmayacak .
2-kodu çalıştırdığım zaman;

Gündüz-------6-----5---- 5
Gece----------5-----5----4
Toplam gün 11+ 10 + 10= 31 gün

Olması gereken;

Gündüz-------6-----5
Gece----------5-----5
Toplam gün 14 + 16 =30 gün

31 gün çeken aylarda ;

Gündüz-------6-----5
Gece----------5-----5
Toplam gün 14 + 17 =31 gün olabilir

birde kod dolgu ile işaretlediğim sütunlara taşmış, EK' li dosyada kod mevcut, yardımcı olur musunuz.
 

Ekli dosyalar

Son düzenleme:
YUSUF44

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
İstenmeyen alana taşmayı gözden kaçırmışım. aşağıdaki şekilde olmalı:

Kod: 
Sub vardiya()
[F14:AJ29] = ""
For kişi = 14 To 29
    If Cells(kişi, "D") = "A" Then
        For gün = 6 To 36
            If Cells(13, gün) <> "" Then
                If WorksheetFunction.Weekday(Cells(13, gün), 2) <> 7 Then
                    Cells(kişi, gün) = 3
                Else
                    Cells(kişi, gün) = "HT"
                End If
            End If
        Next
    ElseIf Cells(kişi, "D") = "M" Then
        For gün = 6 To 36 Step 6
            If Cells(13, gün) <= 36 And Cells(13, gün) <> "" Then Cells(kişi, gün) = 1
            If Cells(13, gün + 1) <= 36 And Cells(13, gün + 1) <> "" Then Cells(kişi, gün + 1) = 1
            If Cells(13, gün + 2) <= 36 And Cells(13, gün + 2) <> "" Then Cells(kişi, gün + 2) = 1
            If Cells(13, gün + 3) <= 36 And Cells(13, gün + 3) <> "" Then Cells(kişi, gün + 3) = 1
            If Cells(13, gün + 4) <= 36 And Cells(13, gün + 4) <> "" Then Cells(kişi, gün + 4) = "HT"
            If Cells(13, gün + 5) <= 36 And Cells(13, gün + 5) <> "" Then Cells(kişi, gün + 5) = "HT"
        Next
    ElseIf Cells(kişi, "D") <> "B" And Cells(kişi, "D") <> "F" And Cells(kişi, "D") <> "İ" Then
        For gün = 6 To 36 Step 6
            If kişi Mod 3 = 0 Then
                If Cells(13, gün) <= 36 And Cells(13, gün) <> "" Then Cells(kişi, gün) = 1
                If Cells(13, gün + 1) <= 36 And Cells(13, gün + 1) <> "" Then Cells(kişi, gün + 1) = 1
                If Cells(13, gün + 2) <= 36 And Cells(13, gün + 2) <> "" Then Cells(kişi, gün + 2) = 2
                If Cells(13, gün + 3) <= 36 And Cells(13, gün + 3) <> "" Then Cells(kişi, gün + 3) = 2
                If Cells(13, gün + 4) <= 36 And Cells(13, gün + 4) <> "" Then Cells(kişi, gün + 4) = "HT"
                If Cells(13, gün + 5) <= 36 And Cells(13, gün + 5) <> "" Then Cells(kişi, gün + 5) = "HT"
            ElseIf kişi Mod 3 = 1 Then
                If Cells(13, gün) <= 36 And Cells(13, gün) <> "" Then Cells(kişi, gün) = 2
                If Cells(13, gün + 1) <= 36 And Cells(13, gün + 1) <> "" Then Cells(kişi, gün + 1) = 2
                If Cells(13, gün + 2) <= 36 And Cells(13, gün + 2) <> "" Then Cells(kişi, gün + 2) = "HT"
                If Cells(13, gün + 3) <= 36 And Cells(13, gün + 3) <> "" Then Cells(kişi, gün + 3) = "HT"
                If Cells(13, gün + 4) <= 36 And Cells(13, gün + 4) <> "" Then Cells(kişi, gün + 4) = 1
                If Cells(13, gün + 5) <= 36 And Cells(13, gün + 5) <> "" Then Cells(kişi, gün + 5) = 1
            ElseIf kişi Mod 3 = 2 Then
                If Cells(13, gün) <= 36 And Cells(13, gün) <> "" Then Cells(kişi, gün) = "HT"
                If Cells(13, gün + 1) <= 36 And Cells(13, gün + 1) <> "" Then Cells(kişi, gün + 1) = "HT"
                If Cells(13, gün + 2) <= 36 And Cells(13, gün + 2) <> "" Then Cells(kişi, gün + 2) = 1
                If Cells(13, gün + 3) <= 36 And Cells(13, gün + 3) <> "" Then Cells(kişi, gün + 3) = 1
                If Cells(13, gün + 4) <= 36 And Cells(13, gün + 4) <> "" Then Cells(kişi, gün + 4) = 2
                If Cells(13, gün + 5) <= 36 And Cells(13, gün + 5) <> "" Then Cells(kişi, gün + 5) = 2
            End If
        Next
    Else
        For gün = 6 To 36 Step 6
            If gün Mod 3 = 0 Then
                If Cells(kişi, "D") = "B" Then
                    If Cells(13, gün) <= 36 And Cells(13, gün) <> "" Then Cells(kişi, gün) = 1
                    If Cells(13, gün + 1) <= 36 And Cells(13, gün + 1) <> "" Then Cells(kişi, gün + 1) = 1
                    If Cells(13, gün + 2) <= 36 And Cells(13, gün + 2) <> "" Then Cells(kişi, gün + 2) = 2
                    If Cells(13, gün + 3) <= 36 And Cells(13, gün + 3) <> "" Then Cells(kişi, gün + 3) = 2
                    If Cells(13, gün + 4) <= 36 And Cells(13, gün + 4) <> "" Then Cells(kişi, gün + 4) = "HT"
                    If Cells(13, gün + 5) <= 36 And Cells(13, gün + 5) <> "" Then Cells(kişi, gün + 5) = "HT"
                ElseIf Cells(kişi, "D") = "F" Then
                    If Cells(13, gün) <= 36 And Cells(13, gün) <> "" Then Cells(kişi, gün) = 2
                    If Cells(13, gün + 1) <= 36 And Cells(13, gün + 1) <> "" Then Cells(kişi, gün + 1) = 2
                    If Cells(13, gün + 2) <= 36 And Cells(13, gün + 2) <> "" Then Cells(kişi, gün + 2) = "HT"
                    If Cells(13, gün + 3) <= 36 And Cells(13, gün + 3) <> "" Then Cells(kişi, gün + 3) = "HT"
                    If Cells(13, gün + 4) <= 36 And Cells(13, gün + 4) <> "" Then Cells(kişi, gün + 4) = 1
                    If Cells(13, gün + 5) <= 36 And Cells(13, gün + 5) <> "" Then Cells(kişi, gün + 5) = 1
                ElseIf Cells(kişi, "D") = "İ" Then
                    If Cells(13, gün) <= 36 And Cells(13, gün) <> "" Then Cells(kişi, gün) = "HT"
                    If Cells(13, gün + 1) <= 36 And Cells(13, gün + 1) <> "" Then Cells(kişi, gün + 1) = "HT"
                    If Cells(13, gün + 2) <= 36 And Cells(13, gün + 2) <> "" Then Cells(kişi, gün + 2) = 1
                    If Cells(13, gün + 3) <= 36 And Cells(13, gün + 3) <> "" Then Cells(kişi, gün + 3) = 1
                    If Cells(13, gün + 4) <= 36 And Cells(13, gün + 4) <> "" Then Cells(kişi, gün + 4) = 2
                    If Cells(13, gün + 5) <= 36 And Cells(13, gün + 5) <> "" Then Cells(kişi, gün + 5) = 2
                End If
            ElseIf gün Mod 3 = 1 Then
                If Cells(kişi, "D") = "B" Then
                    If Cells(13, gün) <= 36 And Cells(13, gün) <> "" Then Cells(kişi, gün) = 2
                    If Cells(13, gün + 1) <= 36 And Cells(13, gün + 1) <> "" Then Cells(kişi, gün + 1) = 2
                    If Cells(13, gün + 2) <= 36 And Cells(13, gün + 2) <> "" Then Cells(kişi, gün + 2) = "HT"
                    If Cells(13, gün + 3) <= 36 And Cells(13, gün + 3) <> "" Then Cells(kişi, gün + 3) = "HT"
                    If Cells(13, gün + 4) <= 36 And Cells(13, gün + 4) <> "" Then Cells(kişi, gün + 4) = 1
                    If Cells(13, gün + 5) <= 36 And Cells(13, gün + 5) <> "" Then Cells(kişi, gün + 5) = 1
                ElseIf Cells(kişi, "D") = "F" Then
                    If Cells(13, gün) <= 36 And Cells(13, gün) <> "" Then Cells(kişi, gün) = "HT"
                    If Cells(13, gün + 1) <= 36 And Cells(13, gün + 1) <> "" Then Cells(kişi, gün + 1) = "HT"
                    If Cells(13, gün + 2) <= 36 And Cells(13, gün + 2) <> "" Then Cells(kişi, gün + 2) = 1
                    If Cells(13, gün + 3) <= 36 And Cells(13, gün + 3) <> "" Then Cells(kişi, gün + 3) = 1
                    If Cells(13, gün + 4) <= 36 And Cells(13, gün + 4) <> "" Then Cells(kişi, gün + 4) = 2
                    If Cells(13, gün + 5) <= 36 And Cells(13, gün + 5) <> "" Then Cells(kişi, gün + 5) = 2
                ElseIf Cells(kişi, "D") = "İ" Then
                    If Cells(13, gün) <= 36 And Cells(13, gün) <> "" Then Cells(kişi, gün) = 1
                    If Cells(13, gün + 1) <= 36 And Cells(13, gün + 1) <> "" Then Cells(kişi, gün + 1) = 1
                    If Cells(13, gün + 2) <= 36 And Cells(13, gün + 2) <> "" Then Cells(kişi, gün + 2) = 2
                    If Cells(13, gün + 3) <= 36 And Cells(13, gün + 3) <> "" Then Cells(kişi, gün + 3) = 2
                    If Cells(13, gün + 4) <= 36 And Cells(13, gün + 4) <> "" Then Cells(kişi, gün + 4) = "HT"
                    If Cells(13, gün + 5) <= 36 And Cells(13, gün + 5) <> "" Then Cells(kişi, gün + 5) = "HT"
                End If
            ElseIf gün Mod 3 = 2 Then
                If Cells(kişi, "D") = "B" Then
                    If Cells(13, gün) <= 36 And Cells(13, gün) <> "" Then Cells(kişi, gün) = "HT"
                    If Cells(13, gün + 1) <= 36 And Cells(13, gün + 1) <> "" Then Cells(kişi, gün + 1) = "HT"
                    If Cells(13, gün + 2) <= 36 And Cells(13, gün + 2) <> "" Then Cells(kişi, gün + 2) = 1
                    If Cells(13, gün + 3) <= 36 And Cells(13, gün + 3) <> "" Then Cells(kişi, gün + 3) = 1
                    If Cells(13, gün + 4) <= 36 And Cells(13, gün + 4) <> "" Then Cells(kişi, gün + 4) = 2
                    If Cells(13, gün + 5) <= 36 And Cells(13, gün + 5) <> "" Then Cells(kişi, gün + 5) = 2
                ElseIf Cells(kişi, "D") = "F" Then
                    If Cells(13, gün) <= 36 And Cells(13, gün) <> "" Then Cells(kişi, gün) = 1
                    If Cells(13, gün + 1) <= 36 And Cells(13, gün + 1) <> "" Then Cells(kişi, gün + 1) = 1
                    If Cells(13, gün + 2) <= 36 And Cells(13, gün + 2) <> "" Then Cells(kişi, gün + 2) = 2
                    If Cells(13, gün + 3) <= 36 And Cells(13, gün + 3) <> "" Then Cells(kişi, gün + 3) = 2
                    If Cells(13, gün + 4) <= 36 And Cells(13, gün + 4) <> "" Then Cells(kişi, gün + 4) = "HT"
                    If Cells(13, gün + 5) <= 36 And Cells(13, gün + 5) <> "" Then Cells(kişi, gün + 5) = "HT"
                ElseIf Cells(kişi, "D") = "İ" Then
                    If Cells(13, gün) <= 36 And Cells(13, gün) <> "" Then Cells(kişi, gün) = 2
                    If Cells(13, gün + 1) <= 36 And Cells(13, gün + 1) <> "" Then Cells(kişi, gün + 1) = 2
                    If Cells(13, gün + 2) <= 36 And Cells(13, gün + 2) <> "" Then Cells(kişi, gün + 2) = "HT"
                    If Cells(13, gün + 3) <= 36 And Cells(13, gün + 3) <> "" Then Cells(kişi, gün + 3) = "HT"
                    If Cells(13, gün + 4) <= 36 And Cells(13, gün + 4) <> "" Then Cells(kişi, gün + 4) = 1
                    If Cells(13, gün + 5) <= 36 And Cells(13, gün + 5) <> "" Then Cells(kişi, gün + 5) = 1
                End If
            End If
        Next
    End If
Next
End Sub
Önceki mesajımda da belirtmiştim, mesai saatleriyle ilgili konuyu ve ekstra izini halledemedim. Beni aşıyor maalesef. Belki üstadlar ilgilenirler.

Ayrıca son açıklamanızı da anlamadım maalesef. Muhtemelen başkaları da anlamaz. Açıklamalarınızı hücre/satır/sütün belirterek ve neden öyle olması gerektiğini açıklayarak yaparsanız yardımcı olacaklar için iyi olur.
 
Garuramon

Garuramon

Katılım
2 Aralık 2013
Mesajlar
401
Excel Vers. ve Dili
Microsoft Office Standard 2013-Türkçe
Altın Üyelik Bitiş Tarihi
22-10-2022
Yusuf Bey,

Öncelikle zaman ayırdığınız ve emeğiniz için çok teşekkür ederim.Ellerinize sağlık.

1-A personeli örnek çalışmasını EK' li dosyada işledim kod kısmana düzenleme yapılabilir misiniz.
Haklı olabilirsiniz ancak düşünüleni yazıya dökmek bazen zor olabiliyor. Mümkün olduğu kadar sade anlatmaya çalışacağım.
2-A personeli hariç diğer 15 personelin çalışması ayın 14 günü gündüz vardiyasında 6 kişi gece vardiyasında 5 kişi , ayın geri kalan 16 günü gündüz ve gece 5 er kişi olmalı ve 2 gündüz 2 gece 2 izin sisteminde çalışma yapmak istiyorum.Bu çalışmada M personeline gündüz nöbet yazılacak ve çalışması 4 gün gündüz 2 gün izin şeklinde olmalı. Sizin yazdığınız kod da M personelinin çalışması gayet başarılı olmuş.

Vardiya kodları açıklamaları excel dosyası içinde C:33 hücresi altında mevcuttur.

Konuyla dediğiniz gibi üstadlar ilgileriniz ise mükemmel olacak.
 

Ekli dosyalar

Son düzenleme:
YUSUF44

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Ekli dosyayı inceleyiniz. 12. ve 13. satırdaki formülleri değiştirdim. Daha önce verdiğim kodları da bu formüllere göre oluşturduğum için sizin dosyanıza uymamıştı. Tüm personellerin gün dağılımları isteğinize göre olmaktadır. Ancak günlük çalışan sayısı ile aylık ekstra izini yapamadım maalesef. Bu çalışmayı temel alarak belki geliştirilebilir.

https://drive.google.com/file/d/1fnbnwiUbiTkaRgw10ogpV0QWoo6ax40h/view?usp=sharing
 
Garuramon

Garuramon

Katılım
2 Aralık 2013
Mesajlar
401
Excel Vers. ve Dili
Microsoft Office Standard 2013-Türkçe
Altın Üyelik Bitiş Tarihi
22-10-2022
Yusuf Bey,

Vardiya dağılımına A personeli dahil edilmemeli A personelini çıkardığım zaman;
Ayın 11 günü 6 kişi gündüz vardiyasında, 5 kişi gece vardiyasında, burada 11 gün değil 14 gün olmalı
10 günü 5 kişi gündüz vardiyasında, 5 kişi gece vardiyasında,
10 günü 5 kişi gündüz vardiyasında, 4 kişi gece vardiyasında,
burayı da 16 gün gündüz vardiyasında 5 kişi, gece vardiyasında 5 kişi 2 gündüz 2 gece 2 izin sistemine göre düzeltebilirsek bu iş tamamdır.

Birde kod kısmındaki dolgu renklerini (LİLA) kaldırır mısınız.Kod bilgim olmadığı için gerekli düzenlemeyi yapamıyorum.

Emekleriniz ve ilginiz için bir kez daha teşekkür ederim.
 

Ekli dosyalar

YUSUF44

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Renk işlemi koşullu biçimlendirme ile yapıldı. Haftasonları belli olsun diye yaptım. İstemiyorsanız koşullu biçimlendirme menüsünden iptal edebilirsiniz.

Daha önce de belirttiğim gibi bundan fazlası elimden gelmiyor maalesef.
 
Garuramon

Garuramon

Katılım
2 Aralık 2013
Mesajlar
401
Excel Vers. ve Dili
Microsoft Office Standard 2013-Türkçe
Altın Üyelik Bitiş Tarihi
22-10-2022
Uzman arkadaşlar yardımcı olur musunuz.
muygun bey, halit3 bey, Ömer BARAN bey:hey:
 
YUSUF44

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Tam olarak istediğiniz gibi olmadı ancak aşağıdaki kodları deneyiniz. Günlük çalışan sayısını ayarlayabiliyor. Ancak hem günllük çalışan sayısını hem de 2+2+2 düzenini yapmak olmuyor. Ne yaptıysam olmadı. Bu nedenle üstüste çalışma ya da üstüste tatil durumu olabiliyor.

Dosyaya bir yardımcı sayfa eklemiştim, inceleyiniz:

https://drive.google.com/file/d/1TGzfll9ZcYmVX0aqI8XDhNhKkekBv-8S/view?usp=sharing

Kod: 
Sub vardiya()
    [F14:AJ29] = ""
Set s1 = Sheets("Kontrol")

    For kişi = 14 To 29
        If Cells(kişi, "D") = "A" Then
            For gün = 6 To 36
                If Cells(13, gün) <> "" Then
                    If WorksheetFunction.Weekday(Cells(13, gün), 2) < 6 Then
                        Cells(kişi, gün) = 3
                    ElseIf WorksheetFunction.Weekday(Cells(13, gün), 2) = 6 Then
                        Cells(kişi, gün) = 4
                    Else
                        Cells(kişi, gün) = "HT"
                    End If
                End If
            Next
        ElseIf Cells(kişi, "D") = "M" Then
            For gün = 6 To 36
                If Cells(13, gün) <> "" Then
                    For i = 2 To 16
10:
                        If s1.Cells(i, "A") = Cells(kişi, "D") Then
                            If WorksheetFunction.CountBlank(s1.Range("B" & i & ":E" & i)) > 0 Then
                                Cells(kişi, gün) = 1
                                yeni = s1.Cells(i, Columns.Count).End(xlToLeft).Column + 1
                                s1.Cells(i, yeni) = 1
                                i = 16
                            ElseIf s1.Cells(i, "F") = "" Then
                                Cells(kişi, gün) = "HT"
                                s1.Cells(i, "F") = "HT"
                                i = 16
                            ElseIf s1.Cells(i, "G") = "" Then
                                Cells(kişi, gün) = "HT"
                                s1.Cells(i, "G") = "HT"
                                i = 16
                            Else
                                s1.Range("B" & i & ":G" & i) = ""
                                GoTo 10
                            End If
                        End If
                    Next
                End If
            Next
            
        ElseIf Cells(kişi, "D") = "B" Or Cells(kişi, "D") = "F" Or Cells(kişi, "D") = "İ" Then
            For gün = 6 To 36 Step 6
                If gün Mod 3 = 0 Then
                    If Cells(kişi, "D") = "B" Then
                        If gün <= 36 And Cells(13, gün) <> "" Then Cells(kişi, gün) = 1
                        If gün + 1 <= 36 And Cells(13, gün + 1) <> "" Then Cells(kişi, gün + 1) = 1
                        If gün + 2 <= 36 And Cells(13, gün + 2) <> "" Then Cells(kişi, gün + 2) = 2
                        If gün + 3 <= 36 And Cells(13, gün + 3) <> "" Then Cells(kişi, gün + 3) = 2
                        If gün + 4 <= 36 And Cells(13, gün + 4) <> "" Then Cells(kişi, gün + 4) = "HT"
                        If gün + 5 <= 36 And Cells(13, gün + 5) <> "" Then Cells(kişi, gün + 5) = "HT"
                    ElseIf Cells(kişi, "D") = "F" Then
                        If gün <= 36 And Cells(13, gün) <> "" Then Cells(kişi, gün) = 2
                        If gün + 1 <= 36 And Cells(13, gün + 1) <> "" Then Cells(kişi, gün + 1) = 2
                        If gün + 2 <= 36 And Cells(13, gün + 2) <> "" Then Cells(kişi, gün + 2) = "HT"
                        If gün + 3 <= 36 And Cells(13, gün + 3) <> "" Then Cells(kişi, gün + 3) = "HT"
                        If gün + 4 <= 36 And Cells(13, gün + 4) <> "" Then Cells(kişi, gün + 4) = 1
                        If gün + 5 <= 36 And Cells(13, gün + 5) <> "" Then Cells(kişi, gün + 5) = 1
                    ElseIf Cells(kişi, "D") = "İ" Then
                        If gün <= 36 And Cells(13, gün) <> "" Then Cells(kişi, gün) = "HT"
                        If gün + 1 <= 36 And Cells(13, gün + 1) <> "" Then Cells(kişi, gün + 1) = "HT"
                        If gün + 2 <= 36 And Cells(13, gün + 2) <> "" Then Cells(kişi, gün + 2) = 1
                        If gün + 3 <= 36 And Cells(13, gün + 3) <> "" Then Cells(kişi, gün + 3) = 1
                        If gün + 4 <= 36 And Cells(13, gün + 4) <> "" Then Cells(kişi, gün + 4) = 2
                        If gün + 5 <= 36 And Cells(13, gün + 5) <> "" Then Cells(kişi, gün + 5) = 2
                    End If
                ElseIf gün Mod 3 = 1 Then
                    If Cells(kişi, "D") = "B" Then
                        If gün <= 36 And Cells(13, gün) <> "" Then Cells(kişi, gün) = 2
                        If gün + 1 <= 36 And Cells(13, gün + 1) <> "" Then Cells(kişi, gün + 1) = 2
                        If gün + 2 <= 36 And Cells(13, gün + 2) <> "" Then Cells(kişi, gün + 2) = "HT"
                        If gün + 3 <= 36 And Cells(13, gün + 3) <> "" Then Cells(kişi, gün + 3) = "HT"
                        If gün + 4 <= 36 And Cells(13, gün + 4) <> "" Then Cells(kişi, gün + 4) = 1
                        If gün + 5 <= 36 And Cells(13, gün + 5) <> "" Then Cells(kişi, gün + 5) = 1
                    ElseIf Cells(kişi, "D") = "F" Then
                        If gün <= 36 And Cells(13, gün) <> "" Then Cells(kişi, gün) = "HT"
                        If gün + 1 <= 36 And Cells(13, gün + 1) <> "" Then Cells(kişi, gün + 1) = "HT"
                        If gün + 2 <= 36 And Cells(13, gün + 2) <> "" Then Cells(kişi, gün + 2) = 1
                        If gün + 3 <= 36 And Cells(13, gün + 3) <> "" Then Cells(kişi, gün + 3) = 1
                        If gün + 4 <= 36 And Cells(13, gün + 4) <> "" Then Cells(kişi, gün + 4) = 2
                        If gün + 5 <= 36 And Cells(13, gün + 5) <> "" Then Cells(kişi, gün + 5) = 2
                    ElseIf Cells(kişi, "D") = "İ" Then
                        If gün <= 36 And Cells(13, gün) <> "" Then Cells(kişi, gün) = 1
                        If gün + 1 <= 36 And Cells(13, gün + 1) <> "" Then Cells(kişi, gün + 1) = 1
                        If gün + 2 <= 36 And Cells(13, gün + 2) <> "" Then Cells(kişi, gün + 2) = 2
                        If gün + 3 <= 36 And Cells(13, gün + 3) <> "" Then Cells(kişi, gün + 3) = 2
                        If gün + 4 <= 36 And Cells(13, gün + 4) <> "" Then Cells(kişi, gün + 4) = "HT"
                        If gün + 5 <= 36 And Cells(13, gün + 5) <> "" Then Cells(kişi, gün + 5) = "HT"
                    End If
                ElseIf gün Mod 3 = 2 Then
                    If Cells(kişi, "D") = "B" Then
                        If gün <= 36 And Cells(13, gün) <> "" Then Cells(kişi, gün) = "HT"
                        If gün + 1 <= 36 And Cells(13, gün + 1) <> "" Then Cells(kişi, gün + 1) = "HT"
                        If gün + 2 <= 36 And Cells(13, gün + 2) <> "" Then Cells(kişi, gün + 2) = 1
                        If gün + 3 <= 36 And Cells(13, gün + 3) <> "" Then Cells(kişi, gün + 3) = 1
                        If gün + 4 <= 36 And Cells(13, gün + 4) <> "" Then Cells(kişi, gün + 4) = 2
                        If gün + 5 <= 36 And Cells(13, gün + 5) <> "" Then Cells(kişi, gün + 5) = 2
                    ElseIf Cells(kişi, "D") = "F" Then
                        If gün <= 36 And Cells(13, gün) <> "" Then Cells(kişi, gün) = 1
                        If gün + 1 <= 36 And Cells(13, gün + 1) <> "" Then Cells(kişi, gün + 1) = 1
                        If gün + 2 <= 36 And Cells(13, gün + 2) <> "" Then Cells(kişi, gün + 2) = 2
                        If gün + 3 <= 36 And Cells(13, gün + 3) <> "" Then Cells(kişi, gün + 3) = 2
                        If gün + 4 <= 36 And Cells(13, gün + 4) <> "" Then Cells(kişi, gün + 4) = "HT"
                        If gün + 5 <= 36 And Cells(13, gün + 5) <> "" Then Cells(kişi, gün + 5) = "HT"
                    ElseIf Cells(kişi, "D") = "İ" Then
                        If gün <= 36 And Cells(13, gün) <> "" Then Cells(kişi, gün) = 2
                        If gün + 1 <= 36 And Cells(13, gün + 1) <> "" Then Cells(kişi, gün + 1) = 2
                        If gün + 2 <= 36 And Cells(13, gün + 2) <> "" Then Cells(kişi, gün + 2) = "HT"
                        If gün + 3 <= 36 And Cells(13, gün + 3) <> "" Then Cells(kişi, gün + 3) = "HT"
                        If gün + 4 <= 36 And Cells(13, gün + 4) <> "" Then Cells(kişi, gün + 4) = 1
                        If gün + 5 <= 36 And Cells(13, gün + 5) <> "" Then Cells(kişi, gün + 5) = 1
                    End If
                End If
            Next
        End If
    Next
            
    For gün = 6 To 36
        If Cells(13, gün) <> "" Then
20:
            kişi = WorksheetFunction.RandBetween(14, 29)
                If Cells(kişi, gün) = "" Then
                    If Cells(kişi, "D") <> "A" And Cells(kişi, "D") <> "M" And Cells(kişi, "D") <> "B" And Cells(kişi, "D") <> "F" And Cells(kişi, "D") <> "İ" Then
                        If Cells(kişi, gün) = "" Then
                            If Cells(kişi, gün - 1) = 2 And Cells(kişi, gün - 2) = 2 And Cells(kişi, gün - 3) = 1 And Cells(kişi, gün - 4) = 1 Then
                                Cells(kişi, gün) = "HT"
                            ElseIf Cells(kişi, gün - 1) = 1 And Cells(kişi, gün - 2) = 1 And Cells(kişi, gün - 3) = 2 And Cells(kişi, gün - 4) = 2 Then
                                Cells(kişi, gün) = "HT"
                            ElseIf Day(Cells(13, gün)) < 15 Then
                                If Cells(kişi, gün - 1) = 1 And Cells(kişi, gün - 2) = 1 Then
                                    If Cells(31, gün) < 5 Then
                                        Cells(kişi, gün) = 2
                                    Else
                                        Cells(kişi, gün) = "HT"
                                    End If
                                ElseIf Cells(kişi, gün - 1) = 2 And Cells(kişi, gün - 2) = 2 Then
                                    If Cells(30, gün) < 6 Then
                                        Cells(kişi, gün) = 1
                                    Else
                                        Cells(kişi, gün) = "HT"
                                    End If
                                ElseIf Cells(kişi, gün - 1) = "HT" And Cells(kişi, gün - 2) = "HT" Then
                                    If Cells(30, gün) < 6 Then
                                        Cells(kişi, gün) = 1
                                    ElseIf Cells(31, gün) < 5 Then
                                        Cells(kişi, gün) = 2
                                    End If
                                ElseIf Cells(31, gün) < 5 Then
                                    Cells(kişi, gün) = 2
                                ElseIf Cells(30, gün) < 6 Then
                                    Cells(kişi, gün) = 1
                                Else
                                    Cells(kişi, gün) = "HT"
                                End If
                            
                            ElseIf Cells(kişi, gün - 1) = 1 And Cells(kişi, gün - 2) = 1 Then
                                If Cells(31, gün) < 5 Then
                                    Cells(kişi, gün) = 2
                                Else
                                    Cells(kişi, gün) = "HT"
                                End If
                            ElseIf Cells(kişi, gün - 1) = 2 And Cells(kişi, gün - 2) = 2 Then
                                If Cells(30, gün) < 5 Then
                                    Cells(kişi, gün) = 1
                                Else
                                    Cells(kişi, gün) = "HT"
                                End If
                            ElseIf Cells(kişi, gün - 1) = "HT" And Cells(kişi, gün - 2) = "HT" Then
                                If Cells(31, gün) < 5 Then
                                    Cells(kişi, gün) = 2
                                ElseIf Cells(30, gün) < 5 Then
                                    Cells(kişi, gün) = 1
                                Else
                                    Cells(kişi, gün) = "HT"
                                End If
                            ElseIf Cells(31, gün) < 5 Then
                                Cells(kişi, gün) = 2
                            ElseIf Cells(30, gün) < 5 Then
                                Cells(kişi, gün) = 1
                            Else
                                Cells(kişi, gün) = "HT"
                            End If
                        End If
                        If WorksheetFunction.CountBlank(Range(Cells(14, gün), Cells(29, gün))) > 0 Then GoTo 20
                    End If
                
            ElseIf WorksheetFunction.CountBlank(Range(Cells(14, gün), Cells(29, gün))) > 0 Then
                GoTo 20
            End If
        End If
    Next
                            

End Sub
 
Son düzenleme:
YUSUF44

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Kodun yardımcı sayfasız hali şu şekilde:

Kod: 
Sub vardiya()
    [F14:AJ29] = ""

    For kişi = 14 To 29
        If Cells(kişi, "D") = "A" Then
            For gün = 6 To 36
                If Cells(13, gün) <> "" Then
                    If WorksheetFunction.Weekday(Cells(13, gün), 2) < 6 Then
                        Cells(kişi, gün) = 3
                    ElseIf WorksheetFunction.Weekday(Cells(13, gün), 2) = 6 Then
                        Cells(kişi, gün) = 4
                    Else
                        Cells(kişi, gün) = "HT"
                    End If
                End If
            Next
        ElseIf Cells(kişi, "D") = "M" Then
        For gün = 6 To 36 Step 6
            If gün <= 36 And Cells(13, gün) <> "" Then Cells(kişi, gün) = 1
            If gün + 1 <= 36 And Cells(13, gün + 1) <> "" Then Cells(kişi, gün + 1) = 1
            If gün + 2 <= 36 And Cells(13, gün + 2) <> "" Then Cells(kişi, gün + 2) = 1
            If gün + 3 <= 36 And Cells(13, gün + 3) <> "" Then Cells(kişi, gün + 3) = 1
            If gün + 4 <= 36 And Cells(13, gün + 4) <> "" Then Cells(kişi, gün + 4) = "HT"
            If gün + 5 <= 36 And Cells(13, gün + 5) <> "" Then Cells(kişi, gün + 5) = "HT"
        Next
            
        ElseIf Cells(kişi, "D") = "B" Or Cells(kişi, "D") = "F" Or Cells(kişi, "D") = "İ" Then
            For gün = 6 To 36 Step 6
                If gün Mod 3 = 0 Then
                    If Cells(kişi, "D") = "B" Then
                        If gün <= 36 And Cells(13, gün) <> "" Then Cells(kişi, gün) = 1
                        If gün + 1 <= 36 And Cells(13, gün + 1) <> "" Then Cells(kişi, gün + 1) = 1
                        If gün + 2 <= 36 And Cells(13, gün + 2) <> "" Then Cells(kişi, gün + 2) = 2
                        If gün + 3 <= 36 And Cells(13, gün + 3) <> "" Then Cells(kişi, gün + 3) = 2
                        If gün + 4 <= 36 And Cells(13, gün + 4) <> "" Then Cells(kişi, gün + 4) = "HT"
                        If gün + 5 <= 36 And Cells(13, gün + 5) <> "" Then Cells(kişi, gün + 5) = "HT"
                    ElseIf Cells(kişi, "D") = "F" Then
                        If gün <= 36 And Cells(13, gün) <> "" Then Cells(kişi, gün) = 2
                        If gün + 1 <= 36 And Cells(13, gün + 1) <> "" Then Cells(kişi, gün + 1) = 2
                        If gün + 2 <= 36 And Cells(13, gün + 2) <> "" Then Cells(kişi, gün + 2) = "HT"
                        If gün + 3 <= 36 And Cells(13, gün + 3) <> "" Then Cells(kişi, gün + 3) = "HT"
                        If gün + 4 <= 36 And Cells(13, gün + 4) <> "" Then Cells(kişi, gün + 4) = 1
                        If gün + 5 <= 36 And Cells(13, gün + 5) <> "" Then Cells(kişi, gün + 5) = 1
                    ElseIf Cells(kişi, "D") = "İ" Then
                        If gün <= 36 And Cells(13, gün) <> "" Then Cells(kişi, gün) = "HT"
                        If gün + 1 <= 36 And Cells(13, gün + 1) <> "" Then Cells(kişi, gün + 1) = "HT"
                        If gün + 2 <= 36 And Cells(13, gün + 2) <> "" Then Cells(kişi, gün + 2) = 1
                        If gün + 3 <= 36 And Cells(13, gün + 3) <> "" Then Cells(kişi, gün + 3) = 1
                        If gün + 4 <= 36 And Cells(13, gün + 4) <> "" Then Cells(kişi, gün + 4) = 2
                        If gün + 5 <= 36 And Cells(13, gün + 5) <> "" Then Cells(kişi, gün + 5) = 2
                    End If
                ElseIf gün Mod 3 = 1 Then
                    If Cells(kişi, "D") = "B" Then
                        If gün <= 36 And Cells(13, gün) <> "" Then Cells(kişi, gün) = 2
                        If gün + 1 <= 36 And Cells(13, gün + 1) <> "" Then Cells(kişi, gün + 1) = 2
                        If gün + 2 <= 36 And Cells(13, gün + 2) <> "" Then Cells(kişi, gün + 2) = "HT"
                        If gün + 3 <= 36 And Cells(13, gün + 3) <> "" Then Cells(kişi, gün + 3) = "HT"
                        If gün + 4 <= 36 And Cells(13, gün + 4) <> "" Then Cells(kişi, gün + 4) = 1
                        If gün + 5 <= 36 And Cells(13, gün + 5) <> "" Then Cells(kişi, gün + 5) = 1
                    ElseIf Cells(kişi, "D") = "F" Then
                        If gün <= 36 And Cells(13, gün) <> "" Then Cells(kişi, gün) = "HT"
                        If gün + 1 <= 36 And Cells(13, gün + 1) <> "" Then Cells(kişi, gün + 1) = "HT"
                        If gün + 2 <= 36 And Cells(13, gün + 2) <> "" Then Cells(kişi, gün + 2) = 1
                        If gün + 3 <= 36 And Cells(13, gün + 3) <> "" Then Cells(kişi, gün + 3) = 1
                        If gün + 4 <= 36 And Cells(13, gün + 4) <> "" Then Cells(kişi, gün + 4) = 2
                        If gün + 5 <= 36 And Cells(13, gün + 5) <> "" Then Cells(kişi, gün + 5) = 2
                    ElseIf Cells(kişi, "D") = "İ" Then
                        If gün <= 36 And Cells(13, gün) <> "" Then Cells(kişi, gün) = 1
                        If gün + 1 <= 36 And Cells(13, gün + 1) <> "" Then Cells(kişi, gün + 1) = 1
                        If gün + 2 <= 36 And Cells(13, gün + 2) <> "" Then Cells(kişi, gün + 2) = 2
                        If gün + 3 <= 36 And Cells(13, gün + 3) <> "" Then Cells(kişi, gün + 3) = 2
                        If gün + 4 <= 36 And Cells(13, gün + 4) <> "" Then Cells(kişi, gün + 4) = "HT"
                        If gün + 5 <= 36 And Cells(13, gün + 5) <> "" Then Cells(kişi, gün + 5) = "HT"
                    End If
                ElseIf gün Mod 3 = 2 Then
                    If Cells(kişi, "D") = "B" Then
                        If gün <= 36 And Cells(13, gün) <> "" Then Cells(kişi, gün) = "HT"
                        If gün + 1 <= 36 And Cells(13, gün + 1) <> "" Then Cells(kişi, gün + 1) = "HT"
                        If gün + 2 <= 36 And Cells(13, gün + 2) <> "" Then Cells(kişi, gün + 2) = 1
                        If gün + 3 <= 36 And Cells(13, gün + 3) <> "" Then Cells(kişi, gün + 3) = 1
                        If gün + 4 <= 36 And Cells(13, gün + 4) <> "" Then Cells(kişi, gün + 4) = 2
                        If gün + 5 <= 36 And Cells(13, gün + 5) <> "" Then Cells(kişi, gün + 5) = 2
                    ElseIf Cells(kişi, "D") = "F" Then
                        If gün <= 36 And Cells(13, gün) <> "" Then Cells(kişi, gün) = 1
                        If gün + 1 <= 36 And Cells(13, gün + 1) <> "" Then Cells(kişi, gün + 1) = 1
                        If gün + 2 <= 36 And Cells(13, gün + 2) <> "" Then Cells(kişi, gün + 2) = 2
                        If gün + 3 <= 36 And Cells(13, gün + 3) <> "" Then Cells(kişi, gün + 3) = 2
                        If gün + 4 <= 36 And Cells(13, gün + 4) <> "" Then Cells(kişi, gün + 4) = "HT"
                        If gün + 5 <= 36 And Cells(13, gün + 5) <> "" Then Cells(kişi, gün + 5) = "HT"
                    ElseIf Cells(kişi, "D") = "İ" Then
                        If gün <= 36 And Cells(13, gün) <> "" Then Cells(kişi, gün) = 2
                        If gün + 1 <= 36 And Cells(13, gün + 1) <> "" Then Cells(kişi, gün + 1) = 2
                        If gün + 2 <= 36 And Cells(13, gün + 2) <> "" Then Cells(kişi, gün + 2) = "HT"
                        If gün + 3 <= 36 And Cells(13, gün + 3) <> "" Then Cells(kişi, gün + 3) = "HT"
                        If gün + 4 <= 36 And Cells(13, gün + 4) <> "" Then Cells(kişi, gün + 4) = 1
                        If gün + 5 <= 36 And Cells(13, gün + 5) <> "" Then Cells(kişi, gün + 5) = 1
                    End If
                End If
            Next
        End If
    Next
            
    For gün = 6 To 36
        If Cells(13, gün) <> "" Then
20:
            kişi = WorksheetFunction.RandBetween(14, 29)
                If Cells(kişi, gün) = "" Then
                    If Cells(kişi, "D") <> "A" And Cells(kişi, "D") <> "M" And Cells(kişi, "D") <> "B" And Cells(kişi, "D") <> "F" And Cells(kişi, "D") <> "İ" Then
                        If Cells(kişi, gün) = "" Then
                            If Cells(kişi, gün - 1) = 2 And Cells(kişi, gün - 2) = 2 And Cells(kişi, gün - 3) = 1 And Cells(kişi, gün - 4) = 1 Then
                                Cells(kişi, gün) = "HT"
                            ElseIf Cells(kişi, gün - 1) = 1 And Cells(kişi, gün - 2) = 1 And Cells(kişi, gün - 3) = 2 And Cells(kişi, gün - 4) = 2 Then
                                Cells(kişi, gün) = "HT"
                            ElseIf Day(Cells(13, gün)) < 15 Then
                                If Cells(kişi, gün - 1) = 1 And Cells(kişi, gün - 2) = 1 Then
                                    If Cells(31, gün) < 5 Then
                                        Cells(kişi, gün) = 2
                                    Else
                                        Cells(kişi, gün) = "HT"
                                    End If
                                ElseIf Cells(kişi, gün - 1) = 2 And Cells(kişi, gün - 2) = 2 Then
                                    If Cells(30, gün) < 6 Then
                                        Cells(kişi, gün) = 1
                                    Else
                                        Cells(kişi, gün) = "HT"
                                    End If
                                ElseIf Cells(kişi, gün - 1) = "HT" And Cells(kişi, gün - 2) = "HT" Then
                                    If Cells(30, gün) < 6 Then
                                        Cells(kişi, gün) = 1
                                    ElseIf Cells(31, gün) < 5 Then
                                        Cells(kişi, gün) = 2
                                    End If
                                ElseIf Cells(31, gün) < 5 Then
                                    Cells(kişi, gün) = 2
                                ElseIf Cells(30, gün) < 6 Then
                                    Cells(kişi, gün) = 1
                                Else
                                    Cells(kişi, gün) = "HT"
                                End If
                            
                            ElseIf Cells(kişi, gün - 1) = 1 And Cells(kişi, gün - 2) = 1 Then
                                If Cells(31, gün) < 5 Then
                                    Cells(kişi, gün) = 2
                                Else
                                    Cells(kişi, gün) = "HT"
                                End If
                            ElseIf Cells(kişi, gün - 1) = 2 And Cells(kişi, gün - 2) = 2 Then
                                If Cells(30, gün) < 5 Then
                                    Cells(kişi, gün) = 1
                                Else
                                    Cells(kişi, gün) = "HT"
                                End If
                            ElseIf Cells(kişi, gün - 1) = "HT" And Cells(kişi, gün - 2) = "HT" Then
                                If Cells(31, gün) < 5 Then
                                    Cells(kişi, gün) = 2
                                ElseIf Cells(30, gün) < 5 Then
                                    Cells(kişi, gün) = 1
                                Else
                                    Cells(kişi, gün) = "HT"
                                End If
                            ElseIf Cells(31, gün) < 5 Then
                                Cells(kişi, gün) = 2
                            ElseIf Cells(30, gün) < 5 Then
                                Cells(kişi, gün) = 1
                            Else
                                Cells(kişi, gün) = "HT"
                            End If
                        End If
                        If WorksheetFunction.CountBlank(Range(Cells(14, gün), Cells(29, gün))) > 0 Then GoTo 20
                    End If
                
            ElseIf WorksheetFunction.CountBlank(Range(Cells(14, gün), Cells(29, gün))) > 0 Then
                GoTo 20
            End If
        End If
    Next
                            

End Sub
 
Garuramon

Garuramon

Katılım
2 Aralık 2013
Mesajlar
401
Excel Vers. ve Dili
Microsoft Office Standard 2013-Türkçe
Altın Üyelik Bitiş Tarihi
22-10-2022
Yusuf Bey,

Bilginizi bizden esirgemediğiniz için ve desteğiniz içi çok teşekkür ederim.Bakalım üstadlar da yardımcı olmak isterler belki.
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst