Açılan listede bir belli sayıdaki değeri bir kere seçebilme

[alixm]

Merhaba,

Bir üniversitede sınavlara gözetmenlerin atanması gerekli. Gözetmenler de unvanlarına göre kaç sınava girecekleri belli. Örneğin Profesörler 1, Doçentler 5, Dr. Öğr. Üyeleri 15, Ar. Görevlileri ise 25 sınava gözetmenlik yapmak durumundalar. Örneğin bir araştırma görevlisinin ismini 25 satır alt alta yazıp, bunu veri doğrulamayla, gözetmenler listesinde açılan liste yapabiliyorum ama bu listede aynı ismi seçildikten sonra bu seçimin toplam sayıdan düşmesini istiyorum. Nasıl yapabilirim? Linkte örnek dosyayı görebilirsiniz.


http://dosya.co/efex8wg3oiok/gözetmenler.xlsx.html

 

[Asri]

İtina ile hazırlanmamış bir örnek dosyaya nasıl cevap yazılır ki!

Tüm dersleri yazın, gözetmenleri Adı Soyadı1, Adı Soyadı2 larak belirtin, yan kolonuna ünvanlarını yazın.
El ile dağıtım yaparsanız nasıl bir tablo oluşur örnek olarak belirtin.

Sonrası daha kolay olacaktır.

 

[YUSUF44]

Farklı bir çözüm denedim, inceleyiniz. Makrosuz, dinamik alan kullanarak yaptım. Ad yöneticisini ve sheet2'deki formülleri inceleyiniz. Makrolu ya da makrosuz başka çözümler bulunabilir:

https://drive.google.com/file/d/1eM0einZh_4F09-GSTStEAsymCXKQRt5U/view?usp=sharing

 

[alixm]

Teşekkürler. Geçen yıl yapılan listeyi de yükledim. Sınav sayıları, tarihi ve saati hazır geliyor ama henüz gelmedi. Sadece gözetmenlerin atama işi bende olacak.

http://dosya.co/alymerla8huf/2017_18_GÜZ_FİNAL.xlsx.html

 

[Asri]

Ayarlar sayfasında A,B,G,H kolonlarına gerekli bilgileri girin.

* Yazılı sayfasında J kolonunda x olan hücrelere atama yapılmaz.
* Aynı güne aynı gözetmen için bir den fazla atama yapılmaz.
* Atamalar en fazla atama sayısı dikkate alınarak tüm gözetmenler için eşit sayıda yapılır. Göztmen ve atama sayılarında denge yok ise
bir iki gözmende az yada diğerlerine göre daha çok olabilir. Ancak bu çokluk en fazla atama sayısının geçileceğini göstermez.

Harici dosya için,
http://s7.dosya.tc/server10/bitxad/2017_18_GUZ_FINAL_asri.zip.html

Dim atammasay As Long
Dim enaz As Long

Sub menu()
   Application.ScreenUpdating = False
   Call hazirla
   Call yerlestir
   Application.ScreenUpdating = True
   MsgBox ("Göztmen atama işlemi tamamalandı")
End Sub

Sub yerlestir()
   Set sh = Sheets("Ayarlar")
   Set shs = Sheets("YAZILI VE OPTIK")
   sonsatir = sh.Cells(Rows.Count, "B").End(3).Row
   sonsatirl = shs.Cells(Rows.Count, "F").End(3).Row

   For j = 2 To sonsatirl
        atanan = shs.Cells(j, "J").Value
        If UCase(atanan) <> "X" Then shs.Cells(j, "J").Value = ""
      
        tarih = shs.Cells(j, "F").Value
        If UCase(atanan) <> "X" Then
            For i = 2 To sonsatir
               enaz = 99999
               satir = 0
               For k = 2 To sonsatir
                enfazla = 0 + sh.Cells(k, "D").Value
                atamasay = 0 + sh.Cells(k, "C").Value
                sontarih = sh.Cells(k, "E").Value
            
                
                   If atamasay < enfazla And sontarih <> tarih Then
                      atamasay = 0 + sh.Cells(k, "C").Value
                      If atamasay < enaz Then
                         gozetmen = sh.Cells(k, "A").Value
                         unvan = sh.Cells(k, "B").Value
                         enaz = atamasay
                         satir = k
                         If enaz = 0 Then Exit For
                      End If
                   End If
               Next k
            
               If satir > 0 Then
                   sh.Cells(satir, "C").Value = sh.Cells(satir, "C").Value + 1
                   sh.Cells(satir, "E").Value = tarih
                   shs.Cells(j, "J").Value = gozetmen
                   Exit For
               End If
            Next i
        End If
   Next j
    sh.Range("E:E").Clear
End Sub


Sub hazirla()
    Set sh = Sheets("Ayarlar")
    sonsatir = sh.Cells(Rows.Count, "B").End(3).Row
    sh.Range("C:E").Clear
    sh.Range("C1").Value = "Atanan Sayı"
    sh.Range("D1").Value = "En Fazla"
    sh.Range("E1").Value = "Son Tarih"

    sh.Range("D2").FormulaR1C1 = "=VLOOKUP(RC[-2],C[3]:C[4],2,0)"
    sh.Range("D2").AutoFill Destination:=sh.Range("D2:D" & sonsatir)

  
    sh.Columns("D:D").Copy
    sh.Columns("D:D").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
End Sub

 

[alixm]

Teşekkürler ama dosyayı indiremedim. "Altın Üye Olmanız halinde Görebilirsiniz" mesaji geliyor.

 

[küçük kardeş]

Teşekkürler ama dosyayı indiremedim. "Altın Üye Olmanız halinde Görebilirsiniz" mesaji geliyor.

@alixm asri bey kod da göndermiş

 

[Asri]

Teşekkürler ama dosyayı indiremedim. "Altın Üye Olmanız halinde Görebilirsiniz" mesaji geliyor.

mesaja harici dosya linki eklendi.