Öğretmen çift nöbet

[irfnal]

Merhabalar ben bir kod yazdırdım. Kodu kontrol ettim. İşe yaraması gerekiyor ama çalışmıyor.
Okulda öğretmenler nöbet tutuyor fakat yeteri kadar öğretmen olmadığı için 1 nöbet bölgesi ve 1 değişen bölgeyi çift nöbet için ayırdım. bu alana öğretmenlerin uygunluklarına göre çift nöbet ( yani o hafta zaten nöbeti var ama bir gün daha fazladan tutması gerekiyor) ataması yapmak istiyorum. Kod öğretmenlerin uygunluklarını denetleyip hafta stünlarına atamasını yapması gerekiyor ama bir türlü çalıştıramadım.

buton ekleyip butona bastığımda ilk önce birinci hafta için atama sonra tekrar bastığımda bir önceki hafta nöbet tutup tutmadığını kontrol ederek eğer tuttuysa tekrar ona nöbet yazmayacak şekilde 2. haftayı oluşturması gerekiyor sonra bu şekilde devam etmesi gerekiyordu. ve artık tüm öğretmen isimleri kullanıldıktan sonra tekrar daha önceki hafta nöbet tutmuş olasa da tekrar çift nöbet verilmeliydi. yani bir çift nöbet listesi tamamlanmış olup tekrardan başlamak gibi.

nerede hata var yardımcı olur musunuz rica etsem.

Sub CiftNobetAtama()
    Dim ws As Worksheet
    Dim i As Integer, j As Integer
    Dim ogretmenSayisi As Integer
    Dim musaitOgretmenler As Collection
    Dim secilenOgretmen As String
    Dim mevcutHafta As Integer
    Dim oncekiHaftaOgretmenleri As Collection
    Dim gunOgretmenSayisi As Integer
    Dim toplamOgretmen As Integer
    Dim ogretmenIndex As Integer
    Dim gunler As Variant
    gunler = Array("Pazartesi", "Salı", "Çarşamba", "Perşembe", "Cuma")
    
    ' Sayfa belirlemesi
    Set ws = ThisWorkbook.Sheets("NobetListesi")
    ogretmenSayisi = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row ' Kaç öğretmen olduğunu bul
    toplamOgretmen = 6 ' 6 öğretmen kullanılacak
    
    ' Mevcut haftayı belirle (Her hafta G, H, I, J sütunlarında tutuluyor)
    mevcutHafta = 7 ' İlk hafta G sütunu
    ' İlk hafta atama yapılmadıysa G sütununa atama yapalım
    If ws.Cells(1, mevcutHafta).Value = "" Then
        ws.Cells(1, mevcutHafta).Value = "Hafta 1" ' İlk haftayı G sütununda belirt
    End If
    
    ' Önceki haftalardaki nöbetçileri bul
    Set oncekiHaftaOgretmenleri = New Collection
    For i = 2 To ogretmenSayisi
        For j = 7 To mevcutHafta - 1 ' Önceki haftaları kontrol et
            If ws.Cells(i, j).Value <> "" Then
                On Error Resume Next
                oncekiHaftaOgretmenleri.Add ws.Cells(i, 1).Value, ws.Cells(i, 1).Value
                On Error GoTo 0
            End If
        Next j
    Next i
    
    ' Öğretmenlerin uygun olduğu günlere göre nöbet atamasını yap
    ogretmenIndex = 1 ' İlk öğretmen indexi
    
    For j = 0 To 4 ' Pazartesi (index 0) ile Cuma (index 4) arası
        Set musaitOgretmenler = New Collection
        
        ' Günün öğretmen sayısını belirle (Pazartesi 2 öğretmen, diğer günler 1 öğretmen)
        If j = 0 Then
            gunOgretmenSayisi = 2 ' Pazartesi 2 öğretmen
        Else
            gunOgretmenSayisi = 1 ' Diğer günler 1 öğretmen
        End If
        
        ' Uygun olan öğretmenleri belirle
        For i = 2 To ogretmenSayisi
            If ws.Cells(i, j + 2).Value = 1 Then ' Öğretmen o gün uygun mu?
                If Not IsInCollection(oncekiHaftaOgretmenleri, ws.Cells(i, 1).Value) Then ' Önceki haftalarda nöbetçi mi?
                    musaitOgretmenler.Add ws.Cells(i, 1).Value
                End If
            End If
        Next i
        
        ' Belirlenen gün için öğretmenleri ata
        For n = 1 To gunOgretmenSayisi
            If musaitOgretmenler.Count > 0 Then
                secilenOgretmen = musaitOgretmenler(ogretmenIndex)
                ws.Cells(2 + n, mevcutHafta).Value = secilenOgretmen ' Öğretmeni atama
                oncekiHaftaOgretmenleri.Add secilenOgretmen ' Bu öğretmeni bir daha atamamak için koleksiyona ekle
                ogretmenIndex = ogretmenIndex + 1
                If ogretmenIndex > toplamOgretmen Then ogretmenIndex = 1 ' Eğer 6 öğretmeni kullandıysak, başa dön
            Else
                ws.Cells(2 + n, mevcutHafta).Value = "Uygun Öğretmen Yok"
            End If
        Next n
    Next j

    MsgBox "Çift nöbet ataması tamamlandı!", vbInformation
End Sub

Function IsInCollection(col As Collection, item As String) As Boolean
    Dim varItem As Variant
    On Error Resume Next
    varItem = col(item)
    IsInCollection = (Err.Number = 0)
    On Error GoTo 0
End Function