Bende dosyayı tamamlamıştım ekliyorum. Sn Mustafa beyle benzer bir mantık kullanmışız.
Mustafa beye Not: Çalışmanız, aynı tarihte bir isme birden fazla nöbet yazabiliyor. Bunu düzeltirseniz güzel bir çalışma olacak.
BU KODUNUZU KENDİ TASLAĞIMA UYGULAMAYA ÇALIŞTIM ANCAK BİR TÜRLÜ YAPAMADIM
YARDIMCI OLABİLİR MİSİNİZ ACABA RİCA ETSEM KODU BENİM TASLAĞIMA UYARLAYABİLİR MİSNİZ
* AYRICA KODA ŞUNU EKLEYEBİLİR MİYİZ BİR KİŞİ İÇİN ARDA ARDA İKİ GÜNE NÖBET YAZILMASIN
KOD
Sub nobetlistesi()
Randomize
say = WorksheetFunction.CountA([b:b])
son = [d65536].End(3).Row
Range("e3:j33").ClearContents
ekle = 1
20 encok = WorksheetFunction.Max([c:c])
For a = 1 To [b65536].End(3).Row
10 sira = Int(say * Rnd + 1)
isim = Cells(sira, "b")
deg = Cells(sira, "c")
satir = Range("e3:j" & son)(hucresay + ekle).Row
say1 = WorksheetFunction.CountIf(Range("e" & satir & ":j" & satir), isim)
If deg > encok Or say1 > 0 Then GoTo 10
hucresay = hucresay + 1
Range("e3:j" & son)(hucresay) = isim
If Range("e3:j" & son).Count = hucresay Then Exit Sub
Next
GoTo 20
End Sub