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

Katılım
24 Temmuz 2019
Mesajlar
413
Excel Vers. ve Dili
EXCEL 2010 TÜRKÇE
Altın Üyelik Bitiş Tarihi
25-12-2023
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.
 

Ekli dosyalar

Katılım
24 Temmuz 2019
Mesajlar
413
Excel Vers. ve Dili
EXCEL 2010 TÜRKÇE
Altın Üyelik Bitiş Tarihi
25-12-2023
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
 
Katılım
24 Temmuz 2019
Mesajlar
413
Excel Vers. ve Dili
EXCEL 2010 TÜRKÇE
Altın Üyelik Bitiş Tarihi
25-12-2023

EmrExcel16

Destek Ekibi
Destek Ekibi
Katılım
1 Kasım 2012
Mesajlar
1,524
Excel Vers. ve Dili
Office 365 Türkçe
Deneyiniz..

Kontrollerinizi detaylı olarak yapın duruma göre devam edelim.
Kod:
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
 

Ekli dosyalar

Katılım
24 Temmuz 2019
Mesajlar
413
Excel Vers. ve Dili
EXCEL 2010 TÜRKÇE
Altın Üyelik Bitiş Tarihi
25-12-2023
Ü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.
 
Katılım
19 Ocak 2012
Mesajlar
175
Excel Vers. ve Dili
Ağırlıklı olara 2003,2007,2010
Altın Üyelik Bitiş Tarihi
31.10.2023
Deneyiniz..

Kontrollerinizi detaylı olarak yapın duruma göre devam edelim.
Kod:
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.
Kod:
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
 
Katılım
24 Temmuz 2019
Mesajlar
413
Excel Vers. ve Dili
EXCEL 2010 TÜRKÇE
Altın Üyelik Bitiş Tarihi
25-12-2023
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

Destek Ekibi
Destek Ekibi
Katılım
1 Kasım 2012
Mesajlar
1,524
Excel Vers. ve Dili
Office 365 Türkçe
Ü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

Destek Ekibi
Destek Ekibi
Katılım
1 Kasım 2012
Mesajlar
1,524
Excel Vers. ve Dili
Office 365 Türkçe
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.
 
Katılım
24 Temmuz 2019
Mesajlar
413
Excel Vers. ve Dili
EXCEL 2010 TÜRKÇE
Altın Üyelik Bitiş Tarihi
25-12-2023
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

Destek Ekibi
Destek Ekibi
Katılım
1 Kasım 2012
Mesajlar
1,524
Excel Vers. ve Dili
Office 365 Türkçe
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 :)
 
Katılım
19 Ocak 2012
Mesajlar
175
Excel Vers. ve Dili
Ağırlıklı olara 2003,2007,2010
Altın Üyelik Bitiş Tarihi
31.10.2023
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

Destek Ekibi
Destek Ekibi
Katılım
1 Kasım 2012
Mesajlar
1,524
Excel Vers. ve Dili
Office 365 Türkçe
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..
 

Ekli dosyalar

Katılım
24 Temmuz 2019
Mesajlar
413
Excel Vers. ve Dili
EXCEL 2010 TÜRKÇE
Altın Üyelik Bitiş Tarihi
25-12-2023
Emre Bey Merhaba,
Dosyayı heyecanla indirdim ve inceliyorum. Size detaylı bilgi vereceğim inşallah. Ellerinize ve emeklerinize sağlık
 

asdsxx

Altın Üye
Katılım
22 Mayıs 2012
Mesajlar
491
Excel Vers. ve Dili
Excel 2016 Türkçe
Altın Üyelik Bitiş Tarihi
20-02-2025
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

Destek Ekibi
Destek Ekibi
Katılım
1 Kasım 2012
Mesajlar
1,524
Excel Vers. ve Dili
Office 365 Türkçe
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

Altın Üye
Katılım
22 Mayıs 2012
Mesajlar
491
Excel Vers. ve Dili
Excel 2016 Türkçe
Altın Üyelik Bitiş Tarihi
20-02-2025
dediğiniz şekilde yaptığımda bende kilitlendi çalışmadı
 

EmrExcel16

Destek Ekibi
Destek Ekibi
Katılım
1 Kasım 2012
Mesajlar
1,524
Excel Vers. ve Dili
Office 365 Türkçe
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.
 

asdsxx

Altın Üye
Katılım
22 Mayıs 2012
Mesajlar
491
Excel Vers. ve Dili
Excel 2016 Türkçe
Altın Üyelik Bitiş Tarihi
20-02-2025
213535

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