YERLERİNE GÖRE DÖNERLİ NÖBET

[Feylosof]

Sayın hocalarım;
Bu konuyu daha önce açmıştım ne var ki dosyam bağlamında cevap alamamıştım. Bu yüzden konuyu tekrar açmak istiyorum; zira bu dosyamın istediğim formatta cevap bulması benim için çok önemlidir. Detaylı bilgi dosyanın içinde mevcuttur. Ancak açıklamalarda yetersiz kalan nokta cevap vermek için konuyu heyecanla takip edeceğim.
Yardımını esirgemeyecek olan excel ustalarına şimdiden teşekkürlerimi iletiyorum.

 

[Feylosof]

Bu konuya bu haliyle kolaylıkla cevap verebilecek ve aynı zamanda yardımcı olmak isteyen arkadaşların var olduğunu biliyorum. O nedenle konuyu güncelliyorum. Yardım lütfen

 

[Feylosof]

...

 

[EmrExcel16]

Deneyiniz..

Kontrollerinizi detaylı olarak yapın duruma göre devam edelim.

Option Explicit
Sub Test()
    Dim ListSyf, NobtSyf, SonSat, Sayi, Alan, Kbul, AdBul, Bul, firstAddress, a, i, y, x, z
    Set ListSyf = Sheets("Liste")
    Set NobtSyf = Sheets("Nobet Cizelgesi")
    SonSat = ListSyf.Cells(Rows.Count, 2).End(3).Row
    If SonSat < 3 Then Exit Sub
    
    Application.ScreenUpdating = False
    
    Range(NobtSyf.Cells(2, 19), NobtSyf.Cells(200, 27)).ClearContents
    On Error Resume Next
    
    ListSyf.Range("A2").Value = "1"
    ListSyf.Range("A2", "A" & SonSat).DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, Step:=1, Trend:=False
    
    For a = 2 To SonSat
basadon: Sayi = Int((10000 * Rnd) + 1)
        If WorksheetFunction.CountIf(ListSyf.Range("O2:O" & SonSat), Sayi) > 0 Or Sayi = 0 Then GoTo basadon
        ListSyf.Cells(a, "O") = Sayi
    Next
    
    ListSyf.Range("A2:O" & SonSat).Sort Key1:=ListSyf.[O2], Order1:=xlAscending
    
    For i = 4 To 8
    
        For y = 5 To 13
        
            For x = 2 To SonSat
            
                If NobtSyf.Cells(i, 1) = ListSyf.Cells(x, 4) And ListSyf.Cells(x, y) <> "X" Then
                    NobtSyf.Cells(2, y + 14) = NobtSyf.Cells(Rows.Count, y + 14).End(3).Row - 1
                    NobtSyf.Cells(NobtSyf.Cells(Rows.Count, y + 14).End(3).Row + 1, y + 14) = ListSyf.Cells(x, 2)
                End If
                
            Next
            
        Next
        
        Set Alan = Range(NobtSyf.Cells(3, 19), NobtSyf.Cells(200, 27))
        
        For z = 1 To 9
            Kbul = WorksheetFunction.Match(WorksheetFunction.Min(NobtSyf.Range("S2:AA2")), NobtSyf.Range("S2:AA2"), 0)
            AdBul = NobtSyf.Cells(3, Kbul + 18)
            
            NobtSyf.Cells(i, Kbul + 2) = AdBul
            
            Set Bul = Alan.Find(AdBul, , xlValues, xlWhole)
            If Not Bul Is Nothing Then
                firstAddress = Bul.Address
                
                Do
                    Cells(Bul.Row, Bul.Column).ClearContents
                    Set Bul = Alan.FindNext(Bul)
                    
                Loop While Not Bul Is Nothing And Bul.Address <> firstAddress
                
            End If
            Range(NobtSyf.Cells(2, Kbul + 18), NobtSyf.Cells(200, Kbul + 18)).ClearContents
            Alan.SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
        Next
        
        NobtSyf.Range("S2:AA2").ClearContents
        Alan.ClearContents
        
    Next
    
    ListSyf.Range("A2:N" & SonSat).Sort Key1:=ListSyf.[A2], Order1:=xlAscending
    ListSyf.Range("O2:O" & SonSat).ClearContents
    
    Application.ScreenUpdating = True
End Sub

 

[Feylosof]

Üstadım ellerinize sağlık. Harika olmuş. Evet mantık bu şekilde. Bu haliyle bile ciddi bir oranda işimi kolaylaştırmaktadır. Acaba nöbet tutmayacağı alanı atlamak şartıyla geçişleri en yakın sağ sütuna yapacak şekilde ya da karışık değiştirse bile mutlaka düğmeye basınca herkesi hareket ettirecek ve sabit bırakmayacak, muhtemel yerlerin tamamına atamadan daha önce verdiği yere vermeyecek şekilde ayarlamak olanaklı mıdır? Bir diğer konu öğretmenlerin nöbet tuttukları yerlerin istatistiklerini de ekleyebilir miyiz?
Ama şunu belirtmeliyim ki sizin sabır ve hoşgörü ile istediklerimi çözme konusundaki gayretinize ne kadar teşekkür etsem azdır.

 

[nurluali]

Deneyiniz..

Kontrollerinizi detaylı olarak yapın duruma göre devam edelim.

Option Explicit
Sub Test()
    Dim ListSyf, NobtSyf, SonSat, Sayi, Alan, Kbul, AdBul, Bul, firstAddress, a, i, y, x, z
    Set ListSyf = Sheets("Liste")
    Set NobtSyf = Sheets("Nobet Cizelgesi")
    SonSat = ListSyf.Cells(Rows.Count, 2).End(3).Row
    If SonSat < 3 Then Exit Sub
  
    Application.ScreenUpdating = False
  
    Range(NobtSyf.Cells(2, 19), NobtSyf.Cells(200, 27)).ClearContents
    On Error Resume Next
  
    ListSyf.Range("A2").Value = "1"
    ListSyf.Range("A2", "A" & SonSat).DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, Step:=1, Trend:=False
  
    For a = 2 To SonSat
basadon: Sayi = Int((10000 * Rnd) + 1)
        If WorksheetFunction.CountIf(ListSyf.Range("O2:O" & SonSat), Sayi) > 0 Or Sayi = 0 Then GoTo basadon
        ListSyf.Cells(a, "O") = Sayi
    Next
  
    ListSyf.Range("A2:O" & SonSat).Sort Key1:=ListSyf.[O2], Order1:=xlAscending
  
    For i = 4 To 8
  
        For y = 5 To 13
      
            For x = 2 To SonSat
          
                If NobtSyf.Cells(i, 1) = ListSyf.Cells(x, 4) And ListSyf.Cells(x, y) <> "X" Then
                    NobtSyf.Cells(2, y + 14) = NobtSyf.Cells(Rows.Count, y + 14).End(3).Row - 1
                    NobtSyf.Cells(NobtSyf.Cells(Rows.Count, y + 14).End(3).Row + 1, y + 14) = ListSyf.Cells(x, 2)
                End If
              
            Next
          
        Next
      
        Set Alan = Range(NobtSyf.Cells(3, 19), NobtSyf.Cells(200, 27))
      
        For z = 1 To 9
            Kbul = WorksheetFunction.Match(WorksheetFunction.Min(NobtSyf.Range("S2:AA2")), NobtSyf.Range("S2:AA2"), 0)
            AdBul = NobtSyf.Cells(3, Kbul + 18)
          
            NobtSyf.Cells(i, Kbul + 2) = AdBul
          
            Set Bul = Alan.Find(AdBul, , xlValues, xlWhole)
            If Not Bul Is Nothing Then
                firstAddress = Bul.Address
              
                Do
                    Cells(Bul.Row, Bul.Column).ClearContents
                    Set Bul = Alan.FindNext(Bul)
                  
                Loop While Not Bul Is Nothing And Bul.Address <> firstAddress
              
            End If
            Range(NobtSyf.Cells(2, Kbul + 18), NobtSyf.Cells(200, Kbul + 18)).ClearContents
            Alan.SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
        Next
      
        NobtSyf.Range("S2:AA2").ClearContents
        Alan.ClearContents
      
    Next
  
    ListSyf.Range("A2:N" & SonSat).Sort Key1:=ListSyf.[A2], Order1:=xlAscending
    ListSyf.Range("O2:O" & SonSat).ClearContents
  
    Application.ScreenUpdating = True
End Sub

Sayın

Deneyiniz..

Kontrollerinizi detaylı olarak yapın duruma göre devam edelim.

Option Explicit
Sub Test()
    Dim ListSyf, NobtSyf, SonSat, Sayi, Alan, Kbul, AdBul, Bul, firstAddress, a, i, y, x, z
    Set ListSyf = Sheets("Liste")
    Set NobtSyf = Sheets("Nobet Cizelgesi")
    SonSat = ListSyf.Cells(Rows.Count, 2).End(3).Row
    If SonSat < 3 Then Exit Sub
   
    Application.ScreenUpdating = False
   
    Range(NobtSyf.Cells(2, 19), NobtSyf.Cells(200, 27)).ClearContents
    On Error Resume Next
   
    ListSyf.Range("A2").Value = "1"
    ListSyf.Range("A2", "A" & SonSat).DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, Step:=1, Trend:=False
   
    For a = 2 To SonSat
basadon: Sayi = Int((10000 * Rnd) + 1)
        If WorksheetFunction.CountIf(ListSyf.Range("O2:O" & SonSat), Sayi) > 0 Or Sayi = 0 Then GoTo basadon
        ListSyf.Cells(a, "O") = Sayi
    Next
   
    ListSyf.Range("A2:O" & SonSat).Sort Key1:=ListSyf.[O2], Order1:=xlAscending
   
    For i = 4 To 8
   
        For y = 5 To 13
       
            For x = 2 To SonSat
           
                If NobtSyf.Cells(i, 1) = ListSyf.Cells(x, 4) And ListSyf.Cells(x, y) <> "X" Then
                    NobtSyf.Cells(2, y + 14) = NobtSyf.Cells(Rows.Count, y + 14).End(3).Row - 1
                    NobtSyf.Cells(NobtSyf.Cells(Rows.Count, y + 14).End(3).Row + 1, y + 14) = ListSyf.Cells(x, 2)
                End If
               
            Next
           
        Next
       
        Set Alan = Range(NobtSyf.Cells(3, 19), NobtSyf.Cells(200, 27))
       
        For z = 1 To 9
            Kbul = WorksheetFunction.Match(WorksheetFunction.Min(NobtSyf.Range("S2:AA2")), NobtSyf.Range("S2:AA2"), 0)
            AdBul = NobtSyf.Cells(3, Kbul + 18)
           
            NobtSyf.Cells(i, Kbul + 2) = AdBul
           
            Set Bul = Alan.Find(AdBul, , xlValues, xlWhole)
            If Not Bul Is Nothing Then
                firstAddress = Bul.Address
               
                Do
                    Cells(Bul.Row, Bul.Column).ClearContents
                    Set Bul = Alan.FindNext(Bul)
                   
                Loop While Not Bul Is Nothing And Bul.Address <> firstAddress
               
            End If
            Range(NobtSyf.Cells(2, Kbul + 18), NobtSyf.Cells(200, Kbul + 18)).ClearContents
            Alan.SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
        Next
       
        NobtSyf.Range("S2:AA2").ClearContents
        Alan.ClearContents
       
    Next
   
    ListSyf.Range("A2:N" & SonSat).Sort Key1:=ListSyf.[A2], Order1:=xlAscending
    ListSyf.Range("O2:O" & SonSat).ClearContents
   
    Application.ScreenUpdating = True
End Sub

Bende olaya müdahil olmak istiyorum benzer bir paylaşım yapmıştım daha önce. Sayın [B]EmrExcel16[/B] bey elinize sağlık çok güzel çalışıyor. Daha fakat bir iki önerim olacak çizelgede nöbet mahallerinde kaç kişi nöbet tutacak farz edelim ki ön bahçeye 2 kişi veriyoruz veya başka bir nöbet mahalline nöbet mahalleri altına bir satır ekleyip 1 2 1 3 vb rakama göre yapılabilir mi ve Feylosof kardeşin de belirttiği gibi 1 nolu nöbet mahallinde eylül, ekim, kasım, aralık vb kiler kaç nolu nöbet tutuğu ayrı bir sayfada listelenebir miayında kimlerin nöbet tuttuğu

 

[Feylosof]

Sayın

Bende olaya müdahil olmak istiyorum benzer bir paylaşım yapmıştım daha önce. Sayın [B]EmrExcel16[/B] bey elinize sağlık çok güzel çalışıyor. Daha fakat bir iki önerim olacak çizelgede nöbet mahallerinde kaç kişi nöbet tutacak farz edelim ki ön bahçeye 2 kişi veriyoruz veya başka bir nöbet mahalline nöbet mahalleri altına bir satır ekleyip 1 2 1 3 vb rakama göre yapılabilir mi ve Feylosof kardeşin de belirttiği gibi 1 nolu nöbet mahallinde eylül, ekim, kasım, aralık vb kiler kaç nolu nöbet tutuğu ayrı bir sayfada listelenebir miayında kimlerin nöbet tuttuğu

nurluali bey;
Evet birinci maddede söylediğiniz doğru. İkinci maddede ise sayısal istatistikleri kişi bazında amaçlıyorum. kim hangi katta kaç kez nöbet tuttu. gibi

 

[EmrExcel16]

Üstadım ellerinize sağlık. Harika olmuş. Evet mantık bu şekilde. Bu haliyle bile ciddi bir oranda işimi kolaylaştırmaktadır. Acaba nöbet tutmayacağı alanı atlamak şartıyla geçişleri en yakın sağ sütuna yapacak şekilde ya da karışık değiştirse bile mutlaka düğmeye basınca herkesi hareket ettirecek ve sabit bırakmayacak, muhtemel yerlerin tamamına atamadan daha önce verdiği yere vermeyecek şekilde ayarlamak olanaklı mıdır? Bir diğer konu öğretmenlerin nöbet tuttukları yerlerin istatistiklerini de ekleyebilir miyiz?
Ama şunu belirtmeliyim ki sizin sabır ve hoşgörü ile istediklerimi çözme konusundaki gayretinize ne kadar teşekkür etsem azdır.

Rica ederim , ilk isteğinizi anladığımı düşünüyorum , bu şekilde bir çalışma yapmaya çalışacağım . Ikinci isteğiniz için ise ,ilk isteğinizi yapabilmem için bir arşiv oluşturmam gerekecek , hangi öğretmen hangi nöbet yerinde kaç defa bulunmuş bulabilmem için , sanıyorum buda ikinci isteğinizi karşılayacak bir tablo olarak kullanılabilir.

Peki tablonuzda her zaman nöbet yerlerini karşılayacak kadar öğretmen bulunacak mı ? Fazlası olma durumu tahminimce sıkıntı çıkarmayacak ama eğer bulunmama durumu olursa ne olacak .

 

[EmrExcel16]

Sayın

Bende olaya müdahil olmak istiyorum benzer bir paylaşım yapmıştım daha önce. Sayın [B]EmrExcel16[/B] bey elinize sağlık çok güzel çalışıyor. Daha fakat bir iki önerim olacak çizelgede nöbet mahallerinde kaç kişi nöbet tutacak farz edelim ki ön bahçeye 2 kişi veriyoruz veya başka bir nöbet mahalline nöbet mahalleri altına bir satır ekleyip 1 2 1 3 vb rakama göre yapılabilir mi ve Feylosof kardeşin de belirttiği gibi 1 nolu nöbet mahallinde eylül, ekim, kasım, aralık vb kiler kaç nolu nöbet tutuğu ayrı bir sayfada listelenebir miayında kimlerin nöbet tuttuğu

Sayın nurluali bey , eğer yapılan dosya sizinde işinize yarayacak ise tabiki müdahil olabilirsiniz. 2. Öneriniz sayın Feylosof 'un isteği ile aynı gibi bununla alakalı önceki mesajımda açiklamayı yaptım , 1. Öneriniz için ise düşünüldüğünde mantıklı ve yerinde bir öneri , dikkate alacağim.

 

[Feylosof]

Haftalık 45 nöbet yeri var. Öğretmen sayısı 45in üzerinde olursa ki bunları da yerleştirme durumu olacak elbette ama 45in altında öğretmen sayısı olmaz. Olsa da belli salonlara atama yapılmaz diye düşünüyorum. hepsini "x" ile kapatarak.

 

[EmrExcel16]

Tamamdır ögretmen sayısı nöbet yeri sayısindan aşağı düşmeyecek diye dikkate alıyorum , olurda düşerse kod içindeki döngünün durumuna göre sonda kalan nöbet yerleri boş kalacak artik

 

[nurluali]

Tamamdır ögretmen sayısı nöbet yeri sayısindan aşağı düşmeyecek diye dikkate alıyorum , olurda düşerse kod içindeki döngünün durumuna göre sonda kalan nöbet yerleri boş kalacak artik

Evet nöbetçi sayısı yetersiz olursa nöbete kapatılacak yerleri X ile kapatıldığı için sorun olmaz. İlginiz için çok teşekkür ediyorum. Çok nöbetçi gerekmeyen nöbet mahalleri oluyor. sonun çıkmaz

 

[EmrExcel16]

Haftalık 45 nöbet yeri var. Öğretmen sayısı 45in üzerinde olursa ki bunları da yerleştirme durumu olacak elbette ama 45in altında öğretmen sayısı olmaz. Olsa da belli salonlara atama yapılmaz diye düşünüyorum. hepsini "x" ile kapatarak.

Deneyiniz..

 

[Feylosof]

Emre Bey Merhaba,
Dosyayı heyecanla indirdim ve inceliyorum. Size detaylı bilgi vereceğim inşallah. Ellerinize ve emeklerinize sağlık

 

[asdsxx]

Peki ilk bilgi girişi yapılıp buraya nöbet tutulacak yer sayısı ve öğretmen sayısı ve mesela bazı günlerde belirli nöbet yerinde öğretmen azlığından nöbet tutulmaya biliyor. gibi bilgiler girileceği sabit bilgiler bölümü eklenebilir mi?

 

[EmrExcel16]

Peki ilk bilgi girişi yapılıp buraya nöbet tutulacak yer sayısı ve öğretmen sayısı ve mesela bazı günlerde belirli nöbet yerinde öğretmen azlığından nöbet tutulmaya biliyor. gibi bilgiler girileceği sabit bilgiler bölümü eklenebilir mi?

Liste sayfasında X koyulduğunda oraya nöbet atanmıyor.

 

[asdsxx]

dediğiniz şekilde yaptığımda bende kilitlendi çalışmadı

 

[EmrExcel16]

Emre Bey Merhaba,
Dosyayı heyecanla indirdim ve inceliyorum. Size detaylı bilgi vereceğim inşallah. Ellerinize ve emeklerinize sağlık

Denemelerinizi , tüm şartları kaldırarak da yapın , dağılımların eşit yapıldığını göreceksiniz. Şartlar girdiğinde dağılımlar eşit dağılamıyor maalesef.

 

[EmrExcel16]

Ne yaptığınızda kilitlendi tam olarak.

 

[asdsxx]

Yapmaya çalıştığım mantık ama çıkan mesaj...