verileri rastgele dağıtma

[Erdinç FIRTINA]

Değerli forum üyeleri,
Aşağıdaki kodlarla, Sayın Kulomer46'nın hazırlamış olduğu aşağıdaki kodlarla verilerin rastgele dağıtımı yapılabiliyor.

Sub dağıt()
Dim son, i, j, x, y, topla
Randomize Timer
son = Cells(65500, 2).End(xlUp).Row
Range("G6:N36").ClearContents
For i = 6 To son
topla = topla + Cells(i, 4)
Next
If topla > 216 Then
MsgBox "Dağıtılacak isim " & topla & " adet" & Chr(10) & "Dağıtılacak boş yer sayısı " & 216 & " adet" + Chr(10) + "Dağıtım Yapılamıyor, dağıtılacak isim adetini azaltınız.", , " Aşırı Yükleme"
End
End If
For i = 6 To son
For j = 1 To Val(Cells(i, 4).Value)
ilk:
x = Int(Rnd * 31) + 1

If x Mod 7 = 0 Then GoTo ilk
y = Int(Rnd * 8) + 1
If Cells(x + 5, y + 6).Value <> "" Then GoTo ilk
Cells(x + 5, y + 6).Value = Cells(i, 2)
Next
Next
End Sub

Benim öğrenmek istediğim ve yapmak istediğim bunu biraz daha geliştirebilmek.
Sayın Kulomer46'nın hazırlamış olduğu kodlarla bir öğretmene ait bir aylık ders programının düzeni şu şekildedir.

1.Bir öğretmen için ders programı yapılıyor.
2.Günde 8 saat ders var.
3.Hafta sonu (Pazar günü) hariç her güne ve her saate öğrenci verilebiliyor.
4.Aylık süre 31 gün olarak belirlenmiş durumdadır.

Bu kodlarda değişiklik yapılarak;
Örneğin;
1.Öğretmen sayısı 2 veya daha fazla olsun.
2.Bir öğrenci için hangi öğretmenin kaç ders verebileceği belirlensin. (Örnek: 3 öğretmen olsun, her öğrencinin hangi öğretmenden kaç saat ders alabileceği belirlensin.
3.Hafta sonu tatilleri hariç belirlenecek olan farklı bir tatil gününe öğrenci dağıtımı yapılmasın. vb.

Örnek dosya ektedir. Yardımlarınız için şimdiden teşekkürler!!!

 

[Erdinç FIRTINA]

Dosyam ektedir.

Affedersiniz, dosyam ektedir.