nöbet listesi

[miray55]

merhaba
okulumuzda 30 öğretmen var 6 nöbet yeri fakat cuma günleri erkek öğretmenlerimiz nöbet tutmuyor tabloya böyle bir ekleme nasıl yaparım. Diğer günler normal kaydırmalı gidecek sadece cuma günleri bayan öğretmenler kendi aralarında dönüşümlü nöbet tutacaklar yardımcı olur musunuz?

 

[halit3]

Alternetif olarak ekli dosyayı ekliyorum açıklama bölümünü oku ona göre deneme yanılma yolu ile aktarmaları takip et

 

[halit3]

merhaba
okulumuzda 30 öğretmen var 6 nöbet yeri fakat cuma günleri erkek öğretmenlerimiz nöbet tutmuyor tabloya böyle bir ekleme nasıl yaparım. Diğer günler normal kaydırmalı gidecek sadece cuma günleri bayan öğretmenler kendi aralarında dönüşümlü nöbet tutacaklar yardımcı olur musunuz?

Bu kodu Kendi dosyanda dene

Sub karıstir7()


sayf1 = ActiveSheet.Name

Sor = MsgBox("Haftasonu çalışılıyor mu?", vbYesNo, "Haftasonu Durumu?")

If Worksheets(sayf1).Cells(2, "R").Value = "" Or Worksheets(sayf1).Cells(2, "s").Value = "" Then Exit Sub

Worksheets(sayf1).Range("A2:G32").ClearContents
Ay = Array("OCAK", "ŞUBAT", "MART", "NİSAN", "MAYIS", "HAZİRAN", "TEMMUZ", "AĞUSTOS", "EYLÜL", "EKİM", "KASIM", "ARALIK")
Ay = WorksheetFunction.Match([r2], Ay, 0)
tarih = CDate("01." & Ay & "." & [Yıl])
Gün = DateSerial(Year(tarih), Month(tarih) + 1, 0)
For x = 2 To Format(Gün, "dd") + 1
Worksheets(sayf1).Cells(x, "a").Value = Format(CDate(x - 1 & "." & Ay & "." & [Yıl]), "dd.mm.yyyy")
Next


Max = Worksheets(sayf1).Cells(Rows.Count, "O").End(3).Row

ReDim ara1(Max + 1)
ReDim ara2(Max + 1)

Dim arr() As Long
Min = 2 'Başlangıç Satır minimum değer
Max = Worksheets(sayf1).Cells(Rows.Count, "O").End(3).Row  '"10" 'Bitiş Satır maksimum değer

If Max < Min Then Exit Sub

For t = 1 To 7

ReDim arr(Max - Min)
say2 = 0
For i = Min To Max
arr(say2) = say2 + 1
say2 = say2 + 1
Next

For j = 1 To UBound(arr)
x = Int(((Max - Min) * Rnd))
temp = arr(x)
arr(x) = arr(j)
arr(j) = temp
Next j


For i = 0 To UBound(arr)
ara1(i + 2) = Worksheets(sayf1).Cells(arr(i) + 1, "O")
ara2(i + 2) = Worksheets(sayf1).Cells(arr(i) + 1, "N")
Next i

For m = 2 To Worksheets(sayf1).Cells(Rows.Count, "O").End(3).Row
aranan1 = ara1(m)
For n = 2 To Worksheets(sayf1).Cells(Rows.Count, "A").End(3).Row


If Sor = vbNo Then
If Format(Worksheets(sayf1).Cells(n, 1), "dddd") = "Cumartesi" Then GoTo atla1
If Format(Worksheets(sayf1).Cells(n, 1), "dddd") = "Pazar" Then GoTo atla1
End If


bulunan1 = ara2(m)
bulunan2 = Format(Worksheets(sayf1).Cells(n, 1), "dddd")

For k = 2 To Worksheets(sayf1).Cells(2, "Q") + 1
If bulunan1 = "e" And bulunan2 = "Cuma" Then GoTo atla3
If Worksheets(sayf1).Cells(n, k).Value = "" Then
Worksheets(sayf1).Cells(n, k).Value = aranan1
GoTo atla2
Exit For
End If

atla3:
Next k

atla1:
Next n

atla2:
Next m
Next t

MsgBox "işlem tamam"

End Sub

 

[halit3]

3 nolu mesajımda cuma durumunu ekledim. ancak 1 nolu örnek dosyanızda cuma günleri durumu eklense bile diğer günlerde dersi olmayan öğretmenin nöbet tutma durumu ne olacak ?