VBA ve SQL Kullanarak Acceste Nöbet Programı Yazmak

[Astalavista58]

Excel VBA ve SQL kullanarak Access veritabanı üzerinden nöbet programı yazmaya çalışıyorum ama bir yerde takıldım bir türlü aşamıyorum.
Ekteki Excel'deki "NOBET" sayfasının A sütununa, istediğim yılın ve ayın tarihlerini sıralı bir şekilde yazdırıyorum.
Access veritabanında iki tablom bulunuyor, bunlar "personel" ve "nobet".
Nöbet yazılacak personelin sicilleri, "personel" tablosundaki "sicil" sütunu başlığı altında yer alıyor. "nobet" tablosunda da "sicil" adında bir sütun var.
İstediğim şey ise "personel" tablosundaki sicilleri, "nobet" tablosunda aramak. Eğer "nobet" tablosunda sicil bulunuyorsa, "nobettarihi" sütununu kontrol edip her sicilin en son nöbet tuttuğu tarihi belirlemek.
Belirlenen bu tarihler arasında hangi sicilin en eski tarihte nöbet tuttuğunu belirleyip, eskiden yeniye olacak şekilde nöbet tutacak sicilleri, Excel'deki "NOBET" sayfasının B sütununa ayın tüm günlerini dolduracak şekilde yazdırmak istiyorum.
Bu işlemi gerçekleştirirken aynı zamanda yeni eklenen tarihleri Access'teki "nobet" tablosuna kaydetmek istiyorum.

Kısaca personellerin en son tuttuğu nöbetleri belirleyip, bunlar arasında en eski tarihliden yeniye doğru excelde B sütununa yazdırmak, bunu yaparkende yeni tarihleri Accesteki "nobet" tablosuna da kaydetmek. Amacım adaletli bir nöbet sistemi oluşturabilmek

**Nöbetler sadece "personel" tablosunda bilgisi olanlara yazılacak.

Gerçekten bu konuda yardımcı olabilirseniz çok mutlu olacağım çünkü tıkandım ilerleyemiyorum, şimdiden çok teşekkür ederim.
Örnek Acces ve Excel dosyası ektedir

 

[Astalavista58]

Şuan kodda biraz ilerleme kaydettim ancak belirli bir konuda daha yardıma ihtiyacım var.

Şu anda kod, Excel'deki A sütununa kullanıcının InputBox'ta girdiği yıl ve ay bilgilerine dayanarak tarihleri atıyor. B sütununda ise sicillerin en son nöbet tuttuğu tarihe göre nöbet tutacak kişileri yazıyor. C sütununda ise sicilin en son nöbet tutulan tarihini getiriyor.

Ancak karşılaştığım sorun şu: Tüm sicilleri bir kere yazıyor, devam ettiremiyorum. Örneğin, 2024 yılı Şubat ayını seçersem, ayın tüm günlerini (29 gün) dolduracak şekilde sicilleri aynı mantıkta yazmasını istiyorum.

Sub oLustur()
' TARİHLERİ EKLER

    Dim strYil As String
    Dim strAy As String
    Dim ws As Worksheet
   
    strYil = InputBox("Yıl Giriniz:", "Nöbet Programı")
    strAy = InputBox("Ay Giriniz:", "Nöbet Programı")

    Set ws = ThisWorkbook.Sheets("NOBET")
    Dim i As Long, j As Long
    Dim lastDay As Long

    lastDay = Day(DateSerial(CInt(strYil), CInt(strAy) + 1, 0))
    j = 1
    For i = 1 To lastDay
        j = j + 1
        ws.Cells(j, 1).Value = DateSerial(CInt(strYil), CInt(strAy), i)
    Next i
' --------------------------------------------------------------------------------------------------

    Dim conn As Object
    Dim rs As Object
    Dim strSQL As String
    Dim lastRow As Long
    Dim dict As Object
    Dim key As Variant
   
    ' Set up database connection
    Set conn = CreateObject("ADODB.Connection")
    conn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\Users\428011\Desktop\Yeni klasör\DB.accdb;"
    conn.Open
   
    ' Set up recordset
    Set rs = CreateObject("ADODB.Recordset")
   
    ' Create dictionary to store unique records and their most recent shift dates
    Set dict = CreateObject("Scripting.Dictionary")
   
    ' Execute SQL query to get unique records with their most recent shift dates
    strSQL = "SELECT n.sicil, MAX(n.nobettarihi) AS MaxDate " & _
             "FROM nobet n " & _
             "INNER JOIN personel p ON n.sicil = p.sicil " & _
             "GROUP BY n.sicil;"
   
    rs.Open strSQL, conn
   
    ' Store results in the dictionary
    Do While Not rs.EOF
        dict(rs("sicil").Value) = rs("MaxDate").Value
        rs.MoveNext
    Loop
   
    rs.Close
    Set rs = Nothing
   
    ' Close database connection
    conn.Close
    Set conn = Nothing
   
     With ThisWorkbook.Sheets("NOBET")
        ' Find the last row in column B
        lastRow = .Cells(.Rows.Count, "B").End(xlUp).row + 1

        ' Sort the dictionary by date in ascending order
        Set dict = SortDictionaryByValue(dict)

        ' Set up database connection
        Set conn = CreateObject("ADODB.Connection")
        conn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\Users\428011\Desktop\Yeni klasör\DB.accdb;"
        conn.Open

    Dim sicilCount As Long
    sicilCount = Application.InputBox("Kaç tane sicil gireceksiniz?", Type:=1)

    ' Iterate through the dictionary and write to Excel and save to Access
    For Each key In dict.keys
        ' Repeat the entry according to the user's input
        For i = 1 To sicilCount
            ' Write to Excel
            .Cells(lastRow, "B").Value = key
            .Cells(lastRow, "C").Value = dict(key) ' Writing the corresponding date in column C

            ' Save to Access database
            Dim formattedDate As String
            formattedDate = Format(.Cells(lastRow, "A").Value, "dd.mm.yyyy")
            strSQL = "INSERT INTO nobet (sicil, nobettarihi) VALUES ('" & key & "', #" & Replace(formattedDate, ".", "/") & "#);"

            conn.Execute strSQL

            lastRow = lastRow + 1
        Next i
    Next key



        ' Close database connection
        conn.Close
        Set conn = Nothing
    End With
   
End Sub

Function SortDictionaryByValue(dict As Object) As Object
    ' Function to sort a dictionary by its values in ascending order
   
    Dim keys() As Variant
    Dim i As Long, j As Long
    Dim tempKey As Variant
    Dim tempValue As Variant
   
    ' Create an array of keys
    keys = dict.keys
   
    ' Perform a simple bubble sort
    For i = LBound(keys) To UBound(keys) - 1
        For j = i + 1 To UBound(keys)
            If dict(keys(i)) > dict(keys(j)) Then
                ' Swap keys
                tempKey = keys(i)
                keys(i) = keys(j)
                keys(j) = tempKey
            End If
        Next j
    Next i
   
    ' Create a new dictionary to store the sorted values
    Dim sortedDict As Object
    Set sortedDict = CreateObject("Scripting.Dictionary")
   
    ' Populate the new dictionary with sorted values
    For i = LBound(keys) To UBound(keys)
        sortedDict(keys(i)) = dict(keys(i))
    Next i
   
    ' Return the sorted dictionary
    Set SortDictionaryByValue = sortedDict
End Function