Öğrenci Nöbet Proğramı

[Muhammet Okumuş]

1- Önce dosyayı bilgisayarınıza kaydedin.
2- Bu dosyanızı ve taşımak istediğiniz dosyanızı açın.
3- Bu dosyanın sayfa adına sağ tıklayıp "Taşı veya Kopyala" seçeneğini tıklayıp kendi dosyanıza taşıyın veya kopya oluşturun.
4- Daha sonra kendi dosyanızda kod görüntüle yapın ve bir tane Modül ekleyin.
5- O modüle bu kodları yapıştırın.

Sub Nöbet()
Application.ScreenUpdating = False
Range("B6:K36") = ""
For i = 1 To 31
If Cells(i, 19) > 5 Or WorksheetFunction.CountIf(Range("M6:M36"), i) > 0 Then GoTo 10
alt = Cells(Rows.Count, 2).End(3).Row + 1
Cells(alt, 2) = Cells(i, 18).Value
10
Next
son = Cells(Rows.Count, 2).End(3).Row
ögr = Cells(Rows.Count, 26).End(3).Row

For i = 6 To son

'----KAPI

For j = 3 To ögr

Range("AC3:AC" & ögr) = 0

If Cells(j, 27) = "K" Then GoTo 20

adet = WorksheetFunction.CountIf(Range("D6:J36"), Cells(j, 26))
If adet = 1 Then GoTo 20

Cells(i, 4) = Cells(j, 26).Value
Cells(i, 5) = Cells(j, 27).Value
Cells(j, 28) = Cells(j, 28) + 1
Cells(j, 29) = 1
Exit For
20
Next

'----1. KAT
Range("Z3:AC" & ögr).Sort Range("AC3"), xlAscending
Range("AC3:AC" & ögr) = ""
Range("Z3:AB" & ögr).Sort Range("AB3"), xlAscending

For j = 3 To ögr

Range("AC3:AC" & ögr) = 0
adet = WorksheetFunction.CountIf(Range("D6:J36"), Cells(j, 26))
If adet = 1 Then GoTo 30

Cells(i, 7) = Cells(j, 26).Value
Cells(i, 8) = Cells(j, 27).Value
Cells(j, 28) = Cells(j, 28) + 1
Cells(j, 29) = 1
Exit For
30
Next
Range("Z3:AC" & ögr).Sort Range("AC3"), xlAscending
Range("AC3:AC" & ögr) = ""
Range("Z3:AB" & ögr).Sort Range("AB3"), xlAscending
'----2. KAT


For j = 3 To ögr

Range("AC3:AC" & ögr) = 0
adet = WorksheetFunction.CountIf(Range("D6:J36"), Cells(j, 26))
If adet = 1 Then GoTo 40

Cells(i, 10) = Cells(j, 26).Value
Cells(i, 11) = Cells(j, 27).Value
Cells(j, 28) = Cells(j, 28) + 1
Cells(j, 29) = 1
Exit For
40
Next
Range("Z3:AC" & ögr).Sort Range("AC3"), xlAscending
Range("AC3:AC" & ögr) = ""
Range("Z3:AB" & ögr).Sort Range("AB3"), xlAscending
Next
Range("M6:M36") = ""
Application.ScreenUpdating = True
MsgBox "Nöbet çizelgesi tamamlandı.", vbInformation, "Uyarı"

End Sub
Sub Temizle()
sor = MsgBox("Tüm veriler silinsin mi?", vbYesNo, "Uyarı")
If sor = vbNo Then Exit Sub
Application.ScreenUpdating = False
Range("B6:K36") = ""
Range("Z:AB") = ""
son = Cells(Rows.Count, "AG").End(3).Row
Range("Z3:Z" & son) = Range("AG3:AG" & son).Value
Range("AA3:AA" & son) = Range("AI3:AI" & son).Value
Range("AB3:AB" & son) = 0
End Sub


Sub NöbeteGeç()
ActiveWindow.ScrollColumn = 1
ActiveWindow.ScrollRow = 1
End Sub
Sub ListeyeGeç()
ActiveWindow.ScrollColumn = 30
ActiveWindow.ScrollRow = 1
End Sub

7- Sonra düğmelere sağ tıklayın ve makro ataması yapın.
8- Kod sayfasında Nöbet sayfasını seçin ve bu kodları yapıştırın.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Range("AE2:AN2"), Target) Is Nothing Then Exit Sub
If Target.CountLarge > 1 Then Exit Sub
son = Cells(Rows.Count, "AG").End(3).Row
süt = ActiveCell.Column
Range("AF3:AN" & son).Sort Cells(3, süt)
End Sub

 

[meleklerim]

böyle bir program bizim okula da lazım ama, altın üyelik olmadığı için indiremiyorum.
yardımcı olabilecek arkadaş var mı acaba?

 

[Muhammet Okumuş]

Hocam şuan cepten yazıyorum. Altın üye veya destek ekibinden birine rica edin. Paylaşım sitesine veya mail adresinize yüklesinler.

 

[erdenek]

Muhammet hocamın yorumuna istinaden paylaşım sitesine yükledim.


http://s3.dosya.tc/server28/Vbndsl/N_bet.rar.html

 

[meleklerim]

çok teşekkrülerr, hemen indiriyorum

 

[halit3]

Alternatif link

Dosya ve görsel video mevcut

http://www.excel.web.tr/f136/nobet-daoylymy-ile-ilgili-caly-ma-t119798/post687107.html

 

[ALTINYAYLA]

Çok değerli muhammed hocam eklemeden önce şu ayrıntıyı farkettim bu nöbet listesini bizdeki öğrenci veritabanına ekleyebilmemiz için 10 ve 11 sınıfların iki ayrı sayfada olması gerekiyor. ve nöbet sayfası verileri iki ayrı sayfadan çeklesi gerekiyor. azami 300 er kişilik 2 ayrı sınıf sayfalarından (şube sayısına bakılmaksızın o sınıfların toplam sayıları)

 

[Muhammet Okumuş]

İsim listesi tek olunca ne fark ediyor onu anlamadım. 3 nöbet yerinde aynı sınıftan 3 kişi olmayacak mı?

 

[ALTINYAYLA]

Aynı sınıftan değil hocam 10 ve 11. sınıflar bizim veritabanında 2 ayrı liste ve karışık olması farketmemekte hocam.

 

[Muhammet Okumuş]

Dosyanın AG sütununa zaten isimleri yazmanız gerekiyor.

 

[ALTINYAYLA]

O zaman ag sütununa isimleri 10 ve 11. sınıflardan çektirsem olur yani değilmi hocam birde hocam eklenmedi ana veritabanına hata verdi

 

[Muhammet Okumuş]

AG aralığına isimleri AI aralığına cinsiyetlerini giriniz. Söyldeğim aşamaları aynen yaptınız mı? Nasıl bir hata verdi? Dosyanızı görmeden ve ya nasıl yaptığınız bilmeden bir şey söyleyemem.

 

[ALTINYAYLA]

Hata resmi ektedir hocam

 

[Muhammet Okumuş]

Sizin dosyanız 2003 sürümlü. Bu dosya ise 2010 sürümlü. Bu dosyayı 2003 formatında kaydedip ekleme yapınız.

 

[ALTINYAYLA]

Herşey için teşekkür ediyorum değerli hocalarım. Bu programdan ihtiyacı olan herkesin istifade edebilmeleri için http://www.excel.web.tr/f126/ buraya nakledilmesini uygun olacağı kanaatindeyim saygılar...

 

[ALTINYAYLA]

Kıymetli arkadaşlar bu programdaki 3 olan nöbet yerini 4 olarak yapabilirmiyiz...