Kura ile Öğretmen Görevlendirme

Y

Yesilyurtlu

Katılım
22 Mayıs 2009
Mesajlar
1,017
Excel Vers. ve Dili
Office 2003
Selamün Aleyküm.

Üstadlarım müsade varsa adım adım yardımlarınız ile kendime bir "sınav görevlendirme" program yapmak istiyorum.
İlk yapmak istediğim ekli dosyada mevcut.
Yardımlarınızı istirham ediyorum. Eğer yardımlarınız ile bu aşamayı hallederek inşallah 2. sayfayı tanzim edip yardımlarınıza sunacağım.

Selam ve Dua ile
 

Ekli dosyalar

N

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,558
Excel Vers. ve Dili
Ofis 365 Türkçe
Merhaba,

Ekli dosyanızda hiç bir açıklama göremedim ben.
 
Y

Yesilyurtlu

Katılım
22 Mayıs 2009
Mesajlar
1,017
Excel Vers. ve Dili
Office 2003
Necdet Abi Hakkını Helal et Özür Dilerim.

C1 Hücresinde yazılı rakam kadar Öğretmene görev vereceğiz.
Eğer Talepte bulunan öğretmen sayısı yeterli ise e sütununda yer alan SONUÇ kısmına bir kere görev aldığı için 1 yazacak.
Eğer Öğretmen sayısı C1 hücresindeki rakamdan az ise aradaki fark kadar görev alan öğretmenlerden bazılarına 2 görev verecek ve sonuç kısmına 2 yazacak
 
N

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,558
Excel Vers. ve Dili
Ofis 365 Türkçe
Merhaba,

Kod: 
Sub Gorevlendir()
    Dim Ogr_Adt     As Integer, _
        Gorev_Adt   As Integer, _
        Son_Sat     As Integer, _
        Tam_Sayi    As Integer, _
        i           As Integer, _
        j           As Integer, _
        Maksimum    As Integer, _
        Kalan       As Double, _
        c           As Range, _
        Durum       As Boolean
    Application.ScreenUpdating = False
    
    Son_Sat = Cells(Rows.Count, "B").End(3).Row
    j = Cells(Rows.Count, "E").End(3).Row + 1
    
    Ogr_Adt = Son_Sat - 3
    Gorev_Adt = Range("C1")
    
    If Ogr_Adt = 0 Then
        MsgBox "Öğretmen Listesini Oluşturmamışsınız, Lütfen Listeyi Oluşturunuz"
        Exit Sub
    End If
    Application.ScreenUpdating = True
    Range("E4:E" & j).ClearContents
    Tam_Sayi = Int(Gorev_Adt / Ogr_Adt)
    Kalan = (Gorev_Adt / Ogr_Adt) - Int(Gorev_Adt / Ogr_Adt)
    If Not Kalan = 0 Then
        Maksimum = Tam_Sayi + 1
    Else
        Maksimum = Tam_Sayi
    End If
        
    If Tam_Sayi > 0 Then
        Range("E4:E" & Son_Sat) = Tam_Sayi
        i = Ogr_Adt * Tam_Sayi
    End If
    
    Randomize (Now)
    
    Do While i < Gorev_Adt
        Durum = False
        Do
            j = Int((Ogr_Adt * Rnd) + 1)
            If Not Range("E" & j + 3) + 1 > Maksimum Then
                Range("E" & j + 3) = Range("E" & j + 3) + 1
                Durum = True
                i = i + 1
            End If
        Loop Until Durum = True
        
    Loop
    
    MsgBox "DAĞITIM TAMAMLANMIŞTIR.........", vbInformation, "N. YEŞERTENER --> [URL="http://www.excel.web.tr/"]www.excel.web.tr[/URL]"
    
End Sub
 

Ekli dosyalar

Y

Yesilyurtlu

Katılım
22 Mayıs 2009
Mesajlar
1,017
Excel Vers. ve Dili
Office 2003
Necdet abi müsait olursan eğer ikinci sayfayı ekledim. Allah rızası için yardımcı olabilir misiniz?
Dilimin döndüğünce ne yapmak istediğimi arz ettim.
 

Ekli dosyalar

Y

Yesilyurtlu

Katılım
22 Mayıs 2009
Mesajlar
1,017
Excel Vers. ve Dili
Office 2003
Uzmanlarımdan 7 no'lu mesajıma yardım etmelerini istirham edebilir miyim. İlk Kayıt sayfasını Necdet Uzmanım "Allah razı olsun" çözmüştü. Allah nasip etmişse Oturum Belirle sayfasınıda yardımlarınızla çözebilir miyiz?
 
N

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,558
Excel Vers. ve Dili
Ofis 365 Türkçe
Yesilyurtlu' Alıntı:
Necdet abi müsait olursan eğer ikinci sayfayı ekledim. Allah rızası için yardımcı olabilir misiniz?
Dilimin döndüğünce ne yapmak istediğimi arz ettim.
Genişletmek için tıkla ...
Sayın Yesilyurtlu,

Sorunuz çok açık değil, biraz daha açıklayıcı olursanız ve olması gereken listeyi el ile oluşturursanız daha yararlı olacaktır soruyu yanıtlayan arkadaşımız için.
 
Y

Yesilyurtlu

Katılım
22 Mayıs 2009
Mesajlar
1,017
Excel Vers. ve Dili
Office 2003
Necdet Abi;
ilk Kayıt sayfasındaki C1 hücresindeki rakam kadar Sonuç kısmında 14 öğretmen için 1 olarak atadığımız kişiler bulunmaktaydı.
Bu kişilerden
1 - Oturum Belirle sayfasında D1 hücresinde yazan rakam "D1 hücresinde yer alan sayı aynı zamanda Oturumda görev alacak öğretmen sayısını belirlemektedir" kadar ilk Kayıt sayfasında 1 olanlardan rastgele seçerek Oturum Belirle sayfasına öğretmen alacağız.
2 - D1 deki sayı kadar öğretmen aktarımını sağladığımız için en son olarak Oturum Belirle sayfasını TABLOYU AKTAR butonu ile OTURUM 1 sayfa adı ile yeni sayfaya formatını bozmadan aktaracağız.
3 - Tabloyu aktardıktan sonra Oturum Belirle sayfasında 2. oturum için yukarıdaki işlemi tekrar edeceğiz.
 

Ekli dosyalar

Ömer

Ömer

Moderatör
Yönetici
Katılım
18 Ağustos 2007
Mesajlar
22,184
Excel Vers. ve Dili
Microsoft 365 Tr
Ofis 2016 Tr
Merhaba,

Yeni açılacak olan oturum1 sayfasının mantığı nedir? Bu sayfadan başka oluşacakmı. Eğer oluşacaksa yeni açılacak sayfalar, oturum2.oturum3... şeklindemi gidecek.

Konu ile ilgili açıklamalarınız yetersiz.

Tüm detayları gözden geçirip açıklamalarınızı yeniden yapmanızı rica ederim.

Konuyu biliyormuşuz gibi değil, hiç bilmiyormuşuz gibi tüm detaylarını açıklamalısınızki algoritmayı ona göre baştan doğru hazırlayalım.

.
 
Y

Yesilyurtlu

Katılım
22 Mayıs 2009
Mesajlar
1,017
Excel Vers. ve Dili
Office 2003
Üstadım;
Dilimin döndüğünce yapmak istediklarimi arz etmeye çalışayım.

1 - Sınav yapılacağını ve bu sınavda görev almak isteyen öğretmen arkadaşlarımız varsa adlarını yazdırmalarını istiyoruz.

2 - Okullardan gelen isim listesini ilk kayıt sayfasına yazıyoruz.
3 - 3 okulda sınavımız olacağından
1. okul için 8 sınıf 8*2 = 16 asıl 2 yedek = 18 öğretmen
2. okul için 10 sınıf 10*2 = 20 asıl 2 yedek = 22 öğretmen
3. okul için 16 sınıf 16*2 = 32 asıl 2 yedek = 34 öğretmen
görevlendireceğiz.

4 - Okullardan gelen isim listesi toplam 18 + 22 + 34 = 74 öğretmen sayısı kadar ise bu sefer sınav oturumları için sınav salonlarına öğretmen görevlendirmeye başlıyoruz. "Okul bina sorumlusu tarafından Başkan ve Gözetmen olarak kura ile görevlendiriliyor Bizim ile ilgisi bulunmuyor."

5 - Her bir okulda 4 oturum şeklinde sınav yapılıyor. Yani her bir oturum için
1. okula 18 , 2. okula 22, 3. okula 34 öğretmen görevlendirilmesi yapılacak.

Hak veririsiniz ki 4 oturum için 4 * 74 = 296 öğretmen bulmak ilçe için imkansız.

Bunun içindir ki ismini yazdıran öğretmenler arasında eşitlik ilkesine uygun görevlendirme yapmak lazım.

Sınav Görevlendirme Aşaması

6 - Bu görevlendirme işlemini Ekli formda ilk kayıt sayfasındaki Necdet Uzmanımın yaptığı görevlendir butonu ile bilgisayar ortamında C1 hücresine yazılan sayı kadar öğretmen ihtiyacım olduğunu belirtiyorum ve görevlendir diyorum. Sonuç kısmına rakam olarak öğretmenlerin kaç sınavda görev alacağını belirliyorum.

7 - İkinci aşama kaç sınavda görev alacak öğretmenleri oturum bazında sınav yapılacak okullara dağıtma işlemi.
Bunun içinde OTURUM BELİRLE sayfasına geçiyoruz. Bu sayfada D1 hücresinde yazılı rakam kadar ilk kayıt sayfasındaki Sonuç kısmında yazan sayıyı dikkate alarak o öğretmene görev vermek lüzumu doğuyor.
Bu sayfada yapmak istediğim ise şu :
1. oturum için 3 okula öğretmen dağıtmak. Her öğretmen 1. oturumda 1 kere görev alacak şekilde dağıtım yapmak. Aynı öğretmen aynı anda iki okulda bulunamayacağından buna dikkat ederek dağıtım yapmak zorunluluğu var.
1. Oturum için 1. okul sınav salonı için görevlendirme yaptığım zaman O oturum sayfasını 1. okul Cumartesi 1. Oturum diye boş sayfaya formatını bozmadan başka bir sayfaya atıyoruz. 1. okulun cumartesi 1. oturum için görevlendirme işlemi bitiyor.
OTURUM BELİRLE sayfasını 2. okul için cumartesi 1. oturuma öğretmen görevlendirme için temizliyoruz. 1. okul Cumartesi 1. Oturum için yapılan aynı işlemi bu sefer 2. okul için cumartesi 1. oturum için yapacağız. Daha sonra aynı işlemi 3. okul için cumartesi 1. oturum için yapacağız.
Sabah otrumu bittikten sonra Öğleden sonraki oturum için
1. okul için cumartesi 2. oturum için
2. okul için cumartesi 2. oturum için
3. okul için cumartesi 2. oturum için

Pazar Sabah oturum için
1. okul için Pazar 3. oturum için
2. okul için Pazar 3. oturum için
3. okul için Pazar 3. oturum için

Sabah otrumu bittikten sonra Öğleden sonraki oturum için
1. okul için Pazar 4. oturum için
2. okul için Pazar 4. oturum için
3. okul için Pazar 4. oturum için görevlendirmeleri yaparak işlemi bitiriyoruz.

En son tüm oturumlar için kaç sınavda sınavda kaç görev almışsa o öğretmenleri görev taptığı okul bazında tebliğ kısmında topluyoruz. Okul Müdürüne Tebliğ ile diyoruz ki okulunuz öğretmenleri şu şu oturumlarda şu tarihlerde şu saatte görevlendirilmiş Tebliğ edip tebellüğ belgelerini gönderiniz.

Bu işlem ile YAPILACAK TÜM SIKINTILAR SON BULUYOR.

Biraz karışık oldu ama Dilimin döndüğünce anlatmaya çalıştım. Yanlışım oldu ise affınıza sığınıyorum.

Selam ve Dua ile
 

Ekli dosyalar

N

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,558
Excel Vers. ve Dili
Ofis 365 Türkçe
Merhaba,

Sanırım ilk oturumu hallettim, ama sonrakiler nasıl olur bir fikrim yok.

Kolay olmayacağıda kesin.

Hem kura çekilişini değiştirmek zorunda kaldım, hem oturum kodlarını yazmaya çalıştım.

Sayfa isimlerini değiştirdim. İlk Sayfa ismini "Liste", ikinci sayfa ismini ise "Şablon" yaptım.

Oturum sayaları da Oturum1, Oturum2 diye gidecek. Fakat ilk kura çekilişinde Oturum sayfaları silinecek ve yeniden oluşacak.



Kod: 
Sub Gorevlendir()
 
    Dim Ogr_Adt     As Integer, _
        Gorev_Adt   As Integer, _
        Son_Sat     As Integer, _
        Tam_Sayi    As Integer, _
        i           As Integer, _
        j           As Integer, _
        Maksimum    As Integer, _
        Kalan       As Double, _
        c           As Range, _
        Durum       As Boolean, _
        wksL        As Worksheet
    
    Set wksL = Sheets("Liste")
    
    wksL.Select
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
    
[B][COLOR=darkred]    For i = Sheets.Count To 1 Step -1
        If Sheets(i).Name Like "Oturum*" Then Sheets(i).Delete
    Next i[/COLOR][/B]
 
    Son_Sat = Cells(Rows.Count, "B").End(3).Row
    j = Cells(Rows.Count, "E").End(3).Row + 1
    
    Ogr_Adt = Son_Sat - 3
    Gorev_Adt = Range("C1")
    
    If Ogr_Adt = 0 Then
        MsgBox "Öğretmen Listesini Oluşturmamışsınız, Lütfen Listeyi Oluşturunuz"
        Exit Sub
    End If
    Application.ScreenUpdating = True
    Range("E4:E" & j).ClearContents
    Tam_Sayi = Int(Gorev_Adt / Ogr_Adt)
    Kalan = (Gorev_Adt / Ogr_Adt) - Int(Gorev_Adt / Ogr_Adt)
    If Not Kalan = 0 Then
        Maksimum = Tam_Sayi + 1
    Else
        Maksimum = Tam_Sayi
    End If
        
    If Tam_Sayi > 0 Then
        Range("E4:E" & Son_Sat) = Tam_Sayi
        i = Ogr_Adt * Tam_Sayi
    End If
    
    Randomize (Now)
    
    Do While i < Gorev_Adt
        Durum = False
        Do
            j = Int((Ogr_Adt * Rnd) + 1)
            If Not Range("E" & j + 3) + 1 > Maksimum Then
                Range("E" & j + 3) = Range("E" & j + 3) + 1
                Durum = True
                i = i + 1
            End If
        Loop Until Durum = True
        
    Loop
    
    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With
    
    MsgBox "DAĞITIM TAMAMLANMIŞTIR.........", vbInformation, "N. YEŞERTENER --> [URL="http://www.excel.web.tr/"]www.excel.web.tr[/URL]"
    
End Sub
Kod: 
Sub Oturum_Belirle()
    Dim wksL    As Worksheet, _
        wksS    As Worksheet, _
        SatirNo As Integer, _
        SonSat  As Integer, _
        i       As Integer, _
        j       As Integer, _
        iSat    As Integer, _
        OturumN As Integer, _
        Liste(), _
        Adr     As String, _
        c       As Range, _
        Durum   As Boolean
    
    For i = 1 To Sheets.Count
        If Sheets(i).Name Like "Oturum*" Then OturumN = OturumN + 1
    Next i
    
    OturumN = OturumN + 1
    
    Set wksL = Sheets("Liste")
    Set wksS = Sheets("Şablon")
    SatirNo = 12
    
    wksS.Select
    iSat = wksS.Cells.Find("*", , , , xlByRows, xlPrevious).Row
    
    Application.ScreenUpdating = False
    
    wksS.Range("C13:F" & iSat).ClearContents
    
    ReDim Liste(1 To wksL.Range("C1"), 1 To 3)
    
    SonSat = wksL.Cells(Rows.Count, "E").End(3).Row
    If SonSat < 4 Then Exit Sub ' Kimse Belirlenmediyse Çıkar
    i = 0
    
    'Görevlendirecek Olan Öğretmenler Diziye Alınıyor
    '(E sütununda rakam olanlar)
    With wksL.Range("E4:E" & SonSat)
        Set c = .Find("*", LookIn:=xlValues)
        If Not c Is Nothing Then
            Adr = c.Address
            Do
                i = i + 1
                Liste(i, 1) = wksL.Cells(c.Row, "B")
                Liste(i, 2) = wksL.Cells(c.Row, "C")
                Liste(i, 3) = wksL.Cells(c.Row, "E")
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> Adr
        End If
    End With
    'Görevlendirecek Olan Öğretmenler Listeye Alındı
    
    Randomize (Timer)
    i = 0
    Do While i < wksS.Range("D1")
        Durum = False
        Do
            j = Int((wksL.Range("C1") * Rnd) + 1)
            If Liste(j, 1) > "" Then
                Durum = True
                i = i + 1
                SatirNo = SatirNo + 1
                wksS.Cells(SatirNo, "C") = Liste(j, 1)
                wksS.Cells(SatirNo, "D") = Liste(j, 2)
                Liste(j, 1) = ""
                Liste(j, 2) = ""
            End If
        Loop Until Durum = True
    Loop
    
    wksS.Range("C13:D" & SatirNo).Sort Key1:=wksS.Range("C13")
    
    wksS.Copy After:=Sheets(Sheets.Count)
    ActiveSheet.Name = "Oturum" & OturumN
    
    ActiveSheet.Shapes.SelectAll
    Selection.Delete
    ActiveSheet.Shapes.SelectAll
    Selection.Delete
    
    wksS.Select
    
    MsgBox OturumN & ". OTURUM HAZIRLANMIŞTIR.........", vbInformation, "N. YEŞERTENER --> [URL="http://www.excel.web.tr/"]www.excel.web.tr[/URL]"
    
End Sub
 

Ekli dosyalar

Y

Yesilyurtlu

Katılım
22 Mayıs 2009
Mesajlar
1,017
Excel Vers. ve Dili
Office 2003
Necdet Abi Ellerine Sağlık İki Cihanın Cennet Ola.

Liste sayfasında Görevlendir Butonu ile sonuç kısmında 1 yazan "Bir kere sınavda görev alması lazımken" Şablon Kısmında Oturum Belirle Butonu çalıştırılınca

1 - Bir kere görev alması gereken kişi 2 kere görev alıyor. Bu sıkıntıyı giderebilirsek mükemmel olmuş.
2 - Eğer Böyle bir kontrol makenizması kod bakımından zorluk çıkaracaksa bir isim iki kere yazılmışsa Kırmızı 3 kere yazılmışsa Mavi 4 kere yazılmışsa Mor gibi renklerle ifade edebilir miyiz?

Emeklerin için Teşekkür Ederim. Allah Üstadıma mükafatını fazlası ile versin inşallah
 
N

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,558
Excel Vers. ve Dili
Ofis 365 Türkçe
Merhaba,

İşin detayını tam kavrayamadım ama bırakın 1 kere görevlendirmeyi, 10 kere de görevlendirilse Oturum1 e tekrarsız seçim yapılıyor, onun kontrolünü yaptım. Ama sizin dediğinizi tam olarak anlamadım.

Oluşan hatalı durumu dosya üzerinde açıklarsanız sanırım daha aydınlatıcı olur.
 
Y

Yesilyurtlu

Katılım
22 Mayıs 2009
Mesajlar
1,017
Excel Vers. ve Dili
Office 2003
Necdet Abi Selamün Aleyküm Hayırlı Sabahlar
Ben kendimin gittiği yolu arz edeyim belki benim gidiş yolum yanlıştır.
Gidiş yolum sırası ile şöyle :

1 - Liste sayfasında C1 hücresine görevlendirme yapacağım kişi sayısını giriyorum GÖREVLENDİR butonunun tıklıyorum. SONUÇ sütununa kaç kere görevlendirilmesi gereken sayı atıyor. "Burada bir sıkıntı yok"

2 - Şablon sayfasına geçiyorum. D1 Hücresine oturum için görevlendirilecek kişi sayısını giriyorum ardından OTURUM BELİRLE butonuna tıklıyorum. 5 kişi görevlendirilerek OTURUM1 adı ile yeni sayfam atılıyor.

3 - Şabon sayfasında ikinci bir görevlendirme için OTURUM BELİRLE butonuna tıklıyorum OTURUM2 adı ile yeni sayfa atıyor. Bu OTURUM2 sayfasında ise OTURUM1 de olan kişi OTURUM2 de de var. "Bu kişileri ekli dosyada kırmızı renkli olarak belirledim."

Bu sıkıntıyı giderebilir miyiz abi?

Allah Razı Olsun
 

Ekli dosyalar

N

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,558
Excel Vers. ve Dili
Ofis 365 Türkçe
Merhaba,

Biraz sabır, son zamanlarda pek zaman bulamıyorum, aynı zamanda üzerinde de düşünmeye devam ediyorum. Oturum sayısı baştan belli mi?

Destek gelmezse bakacağız başımızın çaresine :)
 
Y

Yesilyurtlu

Katılım
22 Mayıs 2009
Mesajlar
1,017
Excel Vers. ve Dili
Office 2003
Necdet Abi 3 okulumuzda sınav yapılmakta her okula
Cumartesi günü için 2 oturum sayısı *3 okul için = 6 oturum
Pazar günü için 2 oturum sayısı *3 okul için = 6 oturum
olmak üzere 12 oturum verilmekte.

Aklınızın bir köşesinde kaldığımı biliyorum ya o bana yeter abi. Allah Razı Olsun.
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst