Giriş Tarihine Göre Eğitim Planlama

resimdeki şubat vardiyası doğru mu, kontrol eder misiniz?

Dilerim işinize yarar

Private Sub BtnEgitEkle_1_Click()



Dim VrdRS As New ADODB.Recordset

Dim GunRS As New ADODB.Recordset



Dim x, xTarih As Long

Dim VrdSrg, VrdSrgB, GunSrg, KriterMod As String



Dim BasTrh, BitTrh, Modx As Long

Dim ModAdi As String

Dim ModSec() As String



ModSec = Split("4A;4B;4C;4D", ";")

BasTrh = CLng(DateSerial(2020, 2, 1))

BitTrh = CLng(DateSerial(2020, 3, 0))

Modx = CLng(DateSerial(2020, 1, 3))



VrdSrgB = " SELECT liste.Kimlik, liste.vardiya " & _

        " FROM TblTmpVrdy INNER JOIN (liste LEFT JOIN TblEgtm ON liste.Kimlik = TblEgtm.Kisi) ON " & _

        " TblTmpVrdy.Vardiya = liste.vardiya " & _

        " WHERE (((TblEgtm.Kisi) Is Null) AND ((Month([tarih]))=2)"





CurrentDb.Execute "delete from TblTmpVrdy"



'hy_vardiya tablosuna GÜN ve Vardiya ekleme____________________________

For x = BasTrh To BitTrh

    y = DateDiff("d", Modx, x) Mod (24)

    If y > 17 Then ModAdi = "B"

    If y > 11 And y < 18 Then ModAdi = "A"

    If y < 12 Then ModAdi = "D"

    If y < 6 Then ModAdi = "C"

    If InStr(1, "67", Weekday(x, 0)) = 0 Then _

        CurrentDb.Execute " insert into TblTmpVrdy (VardiyaTrh,Vardiya) values (" & x & ",'4" & ModAdi & "')"

Next x

'hy_vardiya tablosuna GÜN ve Vardiya ekleme____________________________BİTTİ



'hy_Eğitim tablosuna KİŞİ ekleme____________________________

ModBas = LBound(ModSec)

modBit = UBound(ModSec)



For x = ModBas To modBit

'hy_Moda_Göre_Günler_Sorgusu_______________________________________________

    GunSrg = " SELECT TblTmpVrdy.VardiyaTrh, TblTmpVrdy.Vardiya " & _

            " FROM TblTmpVrdy " & _

            " WHERE (((TblTmpVrdy.Vardiya)='" & ModSec(x) & "'));"

    GunRS.Open GunSrg, CurrentProject.Connection, adOpenKeyset, adLockOptimistic

    

'hy_Moda_Göre_Kişiler_Sorgusu_______________________________________________

    KriterMod = " AND ((liste.vardiya)='" & ModSec(x) & "')) " & _

                " GROUP BY liste.Kimlik, liste.vardiya "

    VrdSrg = VrdSrgB & KriterMod

    VrdRS.Open VrdSrg, CurrentProject.Connection, adOpenKeyset, adLockOptimistic

    

    Do While VrdRS.RecordCount > 0

    If GunRS.EOF Then GunRS.MoveFirst

                VrdRS.MoveFirst

                

                CurrentDb.Execute " insert into TblEgtm (Gun, Kisi) values (" & CLng(GunRS(0)) & "," & VrdRS(0) & ")"

                VrdRS.Requery

    GunRS.MoveNext



    Loop

    VrdRS.Close

    GunRS.Close

Next x

'hy_Eğitim tablosuna KİŞİ ekleme____________________________BİTTİ

MsgBox "Eğitim Dağıtımı tamamlandı"



End Sub

[attachment=31353]

harika olmuş ustalığınızı konuşturmuşsunuz
bu kod bloğundan öğreneceğim çok şey var ellerinize sağlık

hazır eliniz değmişken problemin kalan kısmınıda bakabilir misiniz kalan kısmı şudur
bu yaptığımız 4 vardiya 6 gün çalışıp 2 gün dinleniyordu ama 24 günde 6 günden 4 vardiya devri daim yapıyordu
bunun gibi kendi arasında dönen 2 farklı grup vardiya daha var

bunlardan birincisi 3 vardiyanın 6 gün çalışıp PAZAR günü dinlendiği 21 günde devri daim yapan yani
AAAAAApazarBBBBBBpazarCCCCCCpazarAAAAAApazarBBBBBBpazarCCCCCCpazarAAAAAA
şeklinde dönen vardiyanın başlangıç tarihi 16.12.2019 21 günde bir dönüyor pazar tatil yapıyor 

ikinci grup vardiya 2 li yine pazarları dinleniyor ama A ve B kendi arasında dönüyor 14 günde bir devri daim yapıyor
AAAAAApazarBBBBBBpazarAAAAAApazarBBBBBBpazarAAAAAApazarBBBBBBpazarAAAAAApazarBBBBBBpazar
şeklinde dönen vardiyanın başlangıç tarihi 16.12.2019 14 günde bir dönüyor pazar tatil yapıyor 


liste_tam diye bir tablo ekledim bu tabloda 
21 günde dönen 3lü vardiyalar 3A,3B,3C 
14 günde dönen 2li vardiyalar 2A,2B 

emeğinize sağlık

Kod yapınız kısa ve öz olmuş kısacası çok güzel ama anlamakta zorlanıyorum
BitTrh = CLng(DateSerial(2020, 3, 0))
tercih etmekle şubatın 28,29 problemi aşılmış oluyor değil mi

If InStr(1, "67", Weekday(x, 0)) = 0 Then
Bu satırıda anlayamadım