• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Öğrenci Nöbet Proğramı

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
Genişletmek için tıkla ...

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
Genişletmek için tıkla ...
 

Ekli dosyalar

böyle bir program bizim okula da lazım ama, altın üyelik olmadığı için indiremiyorum.
yardımcı olabilecek arkadaş var mı acaba?
 
Hocam şuan cepten yazıyorum. Altın üye veya destek ekibinden birine rica edin. Paylaşım sitesine veya mail adresinize yüklesinler.
 
çok teşekkrülerr, hemen indiriyorum
 
Ç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ı)
 
İsim listesi tek olunca ne fark ediyor onu anlamadım. 3 nöbet yerinde aynı sınıftan 3 kişi olmayacak mı?
 
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.
 
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
 
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.
 
Hata resmi ektedir hocam
 

Ekli dosyalar

  • Yeni Bit Eşlem Resmi (1280 x 768).jpg
    Yeni Bit Eşlem Resmi (1280 x 768).jpg
    272.1 KB · Görüntüleme: 8
Sizin dosyanız 2003 sürümlü. Bu dosya ise 2010 sürümlü. Bu dosyayı 2003 formatında kaydedip ekleme yapınız.
 
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...
 
Kıymetli arkadaşlar bu programdaki 3 olan nöbet yerini 4 olarak yapabilirmiyiz...
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst