ilk önce subat diye tablo oluşturdum manuel olarak hafta içi günleri girdim güncelleme sorguları ile modu ve vardia alanlarını doldurdum

UPDATE subat SET subat.modu = (DateDiff('d',"03.01.2020",[tarihi])) Mod "24";

SELECT subat.tarihi, vardiya.v0816 FROM subat INNER JOIN vardiya ON subat.modu = vardiya.[mod];

UPDATE Sorgu3 INNER JOIN subat ON Sorgu3.tarihi = subat.tarihi SET subat.vardia = [v0816];

sonra bu sorgu ilede rapor veri kaynağını oluşturdum

SELECT subat.tarihi AS egitim_tarihi, liste.Kimlik, liste.tarih AS ise_giris_tarihi, Format([tarih],"mm") AS İfade1
FROM subat INNER JOIN liste ON subat.vardia = liste.vardiya
WHERE (((Format([tarih],"mm"))="02"));


ve şöyle bir sonuç aldım

şimdi bu işlemleri Vba kodları ile yapmam lazım aynı zamanda bu listede bir kişi sabah vardiyasında olduğu tüm günlerde var 
yani bir kişi bu listede en az dört en fazla 8 kez tekrarlamış

SELECT Sorgu7.Kimlik, Count(Sorgu7.ise_giris_tarihi) AS Sayise_giris_tarihi FROM Sorgu7 GROUP BY Sorgu7.Kimlik;

yinelenleri bulabiliyoruz

SELECT First(Sorgu7.[Kimlik]) AS [Kimlik Alan], Count(Sorgu7.[Kimlik]) AS YinelemeSayısı
FROM Sorgu7
GROUP BY Sorgu7.[Kimlik]
HAVING (((Count(Sorgu7.[Kimlik]))>1));


ama nasıl her kişi bir kez listede geçmesi için silme işlemi yapabiliriz

dört yinelenen kayıttan üçünü silip birini bırakan bir sorgu varmı 
şu sorgu ile her personelin listede geçtiği ilk tarihi buluyoruz

SELECT liste.Kimlik, First(subat.tarihi) AS egitim_tarihi, First(liste.tarih) AS ise_giris_tarihi, First(Format([tarih],"mm")) AS İfade1
FROM subat INNER JOIN liste ON subat.vardia = liste.vardiya
GROUP BY liste.Kimlik
HAVING (((First(Format([tarih],"mm")))="02"));

liste uzunluğunu 500 den 100 düşürdü ve herkesi 4 ayrı tarihe  (3,10,14,20 şubat) topladı

kullandığım sorgular


Sub sorgula()
    Dim i As Integer
    Dim ay As String
    Dim songun As Integer
   
    ay = ""
    songun = 31
   
    For i = 1 To 12
        If i < 10 Then ay = "0" & i
        If i = 1 Or i = 3 Or i = 5 Or i = 7 Or i = 8 Or i = 10 Or i = 12 Then songun = 31
        If i = 4 Or i = 6 Or i = 9 Or i = 11 Then songun = 30
        If i = 2 Then songun = 29
       
        createTable ay
        insertInto ay, 1, songun
        updateTable ay, "03.01.2020"
        updateTable1 ay
        updateTable2 ay
    Next
End Sub

Sub createTable(ay As String)
    Dim dbs As Database
    Set dbs = OpenDatabase("egitim.accdb")
    dbs.Execute "CREATE TABLE " & "ay" & ay & " (tarihi DATETIME, modu INTEGER, vardia CHAR);"
    dbs.Close
End Sub

Sub insertInto(ay As String, ilk As Integer, son As Integer)
    Dim dbs As Database
    Dim i As Integer
   
    Set dbs = OpenDatabase("egitim.accdb")
   
    For i = ilk To son
    dbs.Execute " INSERT INTO " & "ay" & ay & "" _
            & "(tarihi, modu, vardia) VALUES " _
            & "('" & i & "." & ay & ".2020', '', '');"
    Next
           
    dbs.Close
End Sub
Sub updateTable(ay As String, sabitTarih As String)
    Dim dbs As Database
    Set dbs = OpenDatabase("egitim.accdb")
    dbs.Execute "UPDATE " & "ay" & ay & " SET " & "ay" & ay & ".modu = (DateDiff('d','" & sabitTarih & "',[tarihi])) Mod '24';"
    dbs.Close
End Sub

Sub updateTable1(ay As String)
    Dim dbs As Database
    Set dbs = OpenDatabase("egitim.accdb")
    dbs.Execute "SELECT " & "ay" & ay & ".tarihi, vardiya.v0816 INTO " & "ayvar" & ay & " FROM " & "ay" & ay & " INNER JOIN vardiya ON " & "ay" & ay & ".modu = vardiya.[mod];"
    dbs.Close
End Sub

Sub updateTable2(ay As String)
    Dim dbs As Database
    Set dbs = OpenDatabase("egitim.accdb")
    dbs.Execute "UPDATE " & "ayvar" & ay & " INNER JOIN " & "ay" & ay & " ON " & "ayvar" & ay & ".tarihi = " & "ay" & ay & ".tarihi SET " & "ay" & ay & ".vardia = [v0816];"
    dbs.Close
End Sub