Eğitmen o saatte müsait mi değil mi?

cems · 10 Kasım 2007

Sevgili arkadaşlar
Haftalık hazırlanan bir ders programında eğitmenler sözleşmeli ise haftanın her günü/saati değil bazı günlerin bazı saatlerinde kurumda bulunup branşı olan dersi veriyor.
Bu ders programı hazırlanırken tüm eğitmenlerin zaman kartlarına bakılıp bir günün bir saatinde müsaitse derse atama yapılıyor ve kendisine de bildiriliyor.
Ancak yorulan beyinler yine de hata yaparak eğitmenin gelmeyeceği güne ya da saate atama yapabiliyor. Bunu engelleyip kesin doğru bir cetvel çıkarabilmek için ;
ekteki örnekte:
Sayfa1 :sonuçta çıkması gereken ders programı
Ahmet : Eğitmen Ahmet'in ders verebileceği GÜNLER ve SAATLER
Mehmet : Eğitmen Mehmet'in ders verebileceği GÜNLER ve SAATLER
yer almakta ve eğitmen sayısı (dolayısı ile kartı ) 12 ila 19 arasında değişebilmektedir.

Sonuçta , ders programında "Örnek olarak" Eğitmen Ahmet'in pazartesi günü saat 09:00 dersi için (kendi kartına baktırarak) müsait yada müsait olmadığı bilgisini nasıl getirebiliriz?
Not: Bütün isimler uzun bir listeden sadece branş eğitmenLERinin listesini ayıklayıp gösteren ve seçtiren bir listbox ile gelmekte. Yani bir saat için 1 den fazla eğitmen şansı olabiliyor ve bu şekilde seçilebiliyor. Seçildiği anda müsait durumu da hemen altına gelirse , tutmak ya da başka eğitmeni doğru olarak atamak mümkün olacak.

Böyle bir " doğru veri" toplamayı başarabilmek için sizce nasıl bir makro yapılabilir ?

cems · 10 Kasım 2007

Bu program desteklerinizle bir şekilde oluşunca sanırım bir çok eğitim uğraşanının çok işine yarayacak

Levent Menteşoğlu · 11 Kasım 2007

Ekli dosyayı inceleyin.

cems · 11 Kasım 2007

Sayın leventm
Siz bir harikasınız

Bir excel üstadısınız , yanınızda ben herhalde acemi de degil bakıp duran er oluyorum

Örnekte mükemmel çalışıyor hiç sorunsuz tam olması beklenen gibi ama , asıl çalışmaya uyarlayınca

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [D9:J50]) Is Nothing Then Exit Sub
sut = Target.Column
If Cells(Target.Row, "b") <> "" Then Exit Sub
If WorksheetFunction.CountIf(Columns(sut), Target) > Cells(2, sut) Then
MsgBox Target & " için yasal limit dolmuştur..Lütfen başka atama yapınız..:!!", 48, "Uyarı !"
Target.Select
Target = ""
End If
End Sub

Private Sub Worksheet_Change2(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, [D9:J50]) Is Nothing Then Exit Sub
If Target.Row Mod 3 <> 1 Then Exit Sub
If Sheets("" & Target).Cells(Target.Row + 1, Target.Column) = "Müsait" Then Exit Sub
For a = 2 To Sheets.Count
If Sheets(a).Cells(Target.Row + 1, Target.Column) = "Müsait" Then deg = deg & Sheets(a).Name & Chr(10)
Next
MsgBox Target & " öğretmen müsait değildir" & Chr(10) & Chr(10) & "Müsait öğretmenler aşağıdaki gibidir." & Chr(10) & Chr(10) & deg, 48, "Uyarı !"
Target.Select
Target = ""
End Sub

İlk verdiği hata ambigious name , dolayısı ile ikincisinin ad sonuna 2 ekledim.
Bakması gereken aralığa [D9:J50] gösterdim ve (ders programının kopyası ile )bir hoca kartı yaratıp (bu şekilde listboxa gelen adlar kalıcı oldu) kart adına Eğitmen ahmet mehmet dedim.
Yine birşeyleri göremiyorum sanırım zira çalışmadı. Anladığım kadarı ile hoca müsaitse ses cıkarmıyor değilse msgbox yükseliyor ve müsait olanlara (listboxtaki alternatif hocalara) bakıp onları da söylüyor.

Target ; (listbox'tan seçilen isimlerin) bir alt hücresi ve her iki durumda da burayı boşaltıyor. Eğer boşaltmaz MÜSAİT yazarsa tam tablo kontrolü sağlanabilir ve print tuşuna bu hücreleri silmek için bir kod yazabilir ve bu sözcük olmadan baskı alabilirim .

Sizce çalışmamasının nedeni ; ambigious görmemesi için koyduğum 2 mi ya da hoca adını Eğitmen_ahmet_mehmet şeklinde yazmamış olmam mı?
örnek ile asıl çalışma önyüzündeki farklar
saat b sütununda ve 09:00 formatında ( kod içinde geçen a saat ise o sütun boş). Önemi varsa siz ders_programı yazmışsınız ben DERSPRG yazdım sayfa adı olarak.

Ne yapmamı önerirsiniz? Bugün bunu oluşturabilirsek , gelecek haftanın programı hatasız yapılabilmiş olacak. Çalışmayı özel bilgiler olduğundan buraya yükleyemem ama isterseniz size özel mail adresine gönderebilirim.

cems · 11 Kasım 2007

Bir şeyi daha farkettim , hoca kartlarında DERS ADLARINI getiren bütün listboxlara gerek yok , sadece bütün hoca karelerinde aynı hoca ismi ve altına da kolay seçim için MÜSAİT / MÜSAİT DEĞİL için listbox yapmak yeterli , yapıyorum şu an.
Kart adları ve kart içinde geçen ile ders programında seçilerek gelen isimlerin yazım tarzı : Eğitmen ahmet mehmetoğlu
Umarım sorun teşkil etmez bu şekilde...

Hala deneyerek aşmaya çalışıyorum , neticede sanırım üç ana problemim var:
1-Ambigious'tan kurtulmak
2-Ders adlarından bağımsız direk hoca kartında "o saat için" müsait olup olmadıgına bakıp
ders programında " o saat için" engel olmak ya da bırakmak..
3-İşlevi [D9:J50] karesi için yaptırabilmek , zira 4 saatte bir dinlenme olup saat düzeni kayınca düzgün sıralı bakması doğru olmayabilir. Ancak, ders programı ve bütün hoca kartları birebir aynı,
saatleri aynı sadece hoca kartlarında ders adları yok

Levent Menteşoğlu · 11 Kasım 2007

Aynı isimli iki prosedür olamaz, iki kodu aşağıdaki gibi birleştirin.

Kod:

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, [D9:J50]) Is Nothing Then Exit Sub
sut = Target.Column
If Cells(Target.Row, "b") <> "" Then Exit Sub
If WorksheetFunction.CountIf(Columns(sut), Target) > Cells(2, sut) Then
MsgBox Target & " i&#231;in yasal limit dolmu&#351;tur..L&#252;tfen ba&#351;ka atama yap&#305;n&#305;z..:!!", 48, "Uyar&#305; !"
Target.Select
Target = ""
End If
If Target.Row Mod 3 <> 1 Then Exit Sub
If Sheets("" & Target).Cells(Target.Row + 1, Target.Column) = "M&#252;sait" Then Exit Sub
For a = 2 To Sheets.Count
If Sheets(a).Cells(Target.Row + 1, Target.Column) = "M&#252;sait" Then deg = deg & Sheets(a).Name & Chr(10)
Next
MsgBox Target & " &#246;&#287;retmen m&#252;sait de&#287;ildir" & Chr(10) & Chr(10) & "M&#252;sait &#246;&#287;retmenler a&#351;a&#287;&#305;daki gibidir." & Chr(10) & Chr(10) & deg, 48, "Uyar&#305; !"
Target.Select
Target = ""
End Sub

cems · 12 Kasım 2007

merhaba,
10 Satır kodu sökemedim ya da kafam durdu artık.Çalışmadı yani

Kodların ilk kısmında sorun yok , ambigious da demedi .Buraya kadar sorun yok. Ders programı ve bütün hoca kartlarında ilk yazı olan ,saatlerin bulunduğu B sütunu olduğundan kodları şu şekilde denedim:

If Target.Row Mod 3 <> 1 Then Exit Sub
If Sheets("" & Target).Cells(Target.Row + 1, Target.Column) = "MÜSAİT" Then Exit Sub
For a = 2 To Sheets.Count
If Sheets(b).Cells(Target.Row + 1, Target.Column) = "MÜSAİT" Then deg = deg & Sheets(b).Name & Chr(10)
Next
MsgBox Target & " öğretmen müsait değildir" & Chr(10) & Chr(10) & "Müsait öğretmenler aşağıdaki gibidir." & Chr(10) & Chr(10) & deg, 48, "Uyarı !"
Target.Select
Target = ""
End Sub

Ders programında...............hoca kartında
> ilk ders adı d8'de...........burası boşaltıldı
> ilk hoca adı d9'da...........d9'da
> ilk boşluk d10'da.........d10'da MÜSAİT/MÜSAİT DEĞİL listboxu var.
her ikisinde de ilk saat b sütununda 09:00 formatında b8'de .
hatta a ya bakıp saati gene bulsun diye a sütununa da 9 formatında a8e ve aşağı doğru sıraladım da.

Aynı stil 5 gün için sağa ,ve gündüz+gece dersleri için de aşağı giderek sonuçta hepsinde d8:j49 arasına yerleşiyor.
Yıllardır excel ile uğraştım ve şu kodlamayı çözemedim ne yaptımsa. Bilmediğim yada anlamını kavrayamadığım şey mod 3<>1 kısmı.
Sizi de sıkmaktan çekiniyorum. Belki son bir inceleme daha yapma zahmetine katlanırsanız çok sevinirim.
Saygılar

cems · 12 Kasım 2007

Tekrar başladım bakalım içinden çıkabilecek miyim

Levent Menteşoğlu · 12 Kasım 2007

Orijinal dosyanızı isimleri tamamen değiştirerek eklerseniz çok daha hızlı çözüm bulunabilir.

cems · 12 Kasım 2007

Orijinal çalışmanın özel datası tamamen değiştirilmiş olarak ekte gönderiyorum.
Değiştirirken sanırım SINIFPRG da olan 8+1 engelini de bir şekilde galiba bozdum.Özetle ulaşmak gereken iki konu olarak;

a) 8+1 engeli ve aynı zamanda
b) Bir ders saatinde bir (seçilerek gelen) dersin (seçilerek gelen) hocasının o saatte ders
vermeye müsait olup olmadığını , saate ve hocanın kendi kartına bakarak , müsaitse yazmak ;
müsait değilse uyarı alıp kutuyu silmek..

Sizin MsgBox'unuz harika bir çözüm , bu hoca müsait değil ama şunlar müsait demesi , boş denemeleri de sıfırlıyor.

Bir sürü başka şey arasında toparlayamadım bir türlü. Eminim göz önünde bir çözüm ama bir kere görmedi mi günlerce görmeyebiliyor da insan o küçük değişikliği.
Sayfalarda kilitle karşılaşılırsa , şifre yok direkt boş olarak korumayı kaldırın.Kazara silinmemesi için protect/unprotect düşünmüştüm, ordan kalmış olabilir.
İnceler ve düzeltme konusunda yardım edebilirseniz çok sevinirim.
Saygılar ve teşekkürlerimle

Levent Menteşoğlu · 12 Kasım 2007

Aşağıdaki kodu deneyin.

Kod:

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, [D9:J50]) Is Nothing Then Exit Sub
sut = Target.Column
If Cells(Target.Row, "b") <> "" Then Exit Sub
If WorksheetFunction.CountIf(Columns(sut), Target) > Cells(2, sut) Then
MsgBox Target & " i&#231;in yasal limit dolmu&#351;tur..L&#252;tfen ba&#351;ka atama yap&#305;n&#305;z..:!!", 48, "Uyar&#305; !"
Target.Select
Target = ""
End If
If Sheets("" & Target).Cells(Target.Row + 1, Target.Column) = "M&#220;SA&#304;T" Then Exit Sub
For a = 3 To Sheets.Count
If Sheets(a).Cells(Target.Row + 1, Target.Column) = "M&#220;SA&#304;T" Then deg = deg & Sheets(a).Name & Chr(10)
Next
MsgBox Target & " ;bu ders g&#252;n&#252; ve saati i&#231;in m&#252;sait de&#287;ildir" & Chr(10) & Chr(10) & "M&#252;sait &#246;&#287;retmenler a&#351;a&#287;&#305;daki gibidir.L&#252;tfen bu e&#287;itmenlerden atama yap&#305;n&#305;z..." & Chr(10) & Chr(10) & deg, 48, "Uyar&#305; !"
Target.Select
Target = ""
End Sub

cems · 13 Kasım 2007

Sayın leventm
Akşam zaman bulamasam da sabah ilk iş olarak düzenlediğiniz kodu denedim ve ilk sütunda her iki konuda da mükemmel çalıştı. İşyerinde tüm tablo olarak deneme şansım olacak. Kodlara göz attım , ama sabah mahmurluğu herhalde yine hatamı keşfedemedim.
Elleriniz dert görmesin , 1 günlük çalışma sayenizde ( toplam) 20 dakikaya inmiş oldu.
Sanırım eğitim içinde olan birçok arkadaşımızın da çok işine yarayacak.
Allah sizden razı olsun cok tesekkür ederim

cems · 14 Kasım 2007

Sayın leventm
Ana programı hazırladım ve tüm hocaları yerlestirdim , daha önce farketmediğimiz birşey oldu. Kodlar mükemmel çalışıyor. Dikkatimizden kaçan ; program (seçilen) dersin ( seçilerek gelen ) branş hocalarını değil , o gün o saatte ne kadar müsait hoca varsa hepsini getiriyor ve içlerinde ( seçilmiş ) branş hocası da olmayabiliyor.
Sanırım yine ufak bir gözlem ve düzeltme daha gerekecek ...
Yardım edebilir misiniz tekrar? Şuanki kod düzeninde hasar yaratmaya çekindiğim için kopyalarda çözmeye ben de çalışıyorum ama bir üstadın gözlemi daha da hızlı olabilir

Saygılar

Levent Menteşoğlu · 14 Kasım 2007

Aşağıdaki kodu deneyin. Yalnız tam olarak deneyemedim. İsimlerin sonundaki -HS eklemeleri sorun çıkartacaktır.

Kod:

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, [D9:J50]) Is Nothing Then Exit Sub
sut = Target.Column
If Cells(Target.Row, "b") <> "" Then Exit Sub
If WorksheetFunction.CountIf(Columns(sut), Target) > Cells(2, sut) Then
MsgBox Target & " i&#231;in yasal limit dolmu&#351;tur..L&#252;tfen ba&#351;ka atama yap&#305;n&#305;z..:!!", 48, "Uyar&#305; !"
Target.Select
Target = ""
End If
If Sheets("" & Target).Cells(Target.Row + 1, Target.Column) = "M&#220;SA&#304;T" Then Exit Sub
sat = WorksheetFunction.Match(Target.Offset(-1, 0), Sheets("HOCALIST").[b:b], 0)
For a = 3 To Sheets.Count
If WorksheetFunction.CountIf(Sheets("HOCALIST").Rows(sat), "*" & Sheets(a).Name & "*") > 0 And Sheets(a).Cells(Target.Row + 1, Target.Column) = "M&#220;SA&#304;T" Then deg = deg & Sheets(a).Name & Chr(10)
Next
MsgBox Target & " ;bu ders g&#252;n&#252; ve saati i&#231;in m&#252;sait de&#287;ildir" & Chr(10) & Chr(10) & "M&#252;sait &#246;&#287;retmenler a&#351;a&#287;&#305;daki gibidir.L&#252;tfen bu e&#287;itmenlerden atama yap&#305;n&#305;z..." & Chr(10) & Chr(10) & deg, 48, "Uyar&#305; !"
Target.Select
Target = ""
End Sub

cems · 14 Kasım 2007

Sayın leventm
Nedenini henüz kontrol edemedim kodları okumaya çalışarak ama , bu en son kod tam bir karışıklık yarattı. Ptesi 9:00 ve onemli ders a icin acılan alternatif hoca 1 (olması gereken 4 yada 5) ve bu hocanın da branşı değil.Diger bölgelerde de benzer karışıklık oldu , asıl calısma uzerinde de denedim ( 2o kadar hoca dizili ) sonuç aynı oldu.
En azından bir önceki kod versiyonu ile ( boşta kalan tüm hocalardan seçerek) devam edebilir miyim diye düşünüyorum , size daha fazla eziyete neden olmaktansa...
İsimlerde - HS lerin tamamını kaldırdım, HS'le haftasonu anlamındaydı , zaten kartlarında haftasonu saatlerinde müsait işlendiler.Kart adlarını da örn: Ahmet Mehmetoğlu tarzında açtım ( Ahmet_Mehmetoğlu değil ) .HOCALIST teki hoca adları bu şekilde normal , alt tiresiz.
Sadece branş hocalardan sectirmek , programı hazırlayandan da programın sağlıklılığından da emin olmayı getirecekti ve müsait seçenekler kesin doğru olacaktı...
İnceleyip düzeltmede yardıma devam edebilir misiniz demeye yüzüm varmıyor artık
Derin saygılar

cems · 16 Kasım 2007

Sayın leventm

Problemi sanırım buldum :
Biraz önce ders programı ile tüm hocaların kartlarının gün tarihi aynı yapınca hiçbir sorun olmadan tüm kareler doğru çalıştı ve MÜSAİT OLMAYAN bir hoca seçildiğinde durdurup SADECE branş hocalarından MÜSAİT olanları msgbox üzerinde gösterdi.
Uyarınız üzerine -HS leri tamamen kaldırıp kart isimlerini de "Ahmet Mehmetoğlu" formatında yazdım , hiç sorun yok.

Çok teşekkür ederim

sherlockholmes · 29 Ağustos 2008

Güzel bir programa benziyor , bitmiş halini gönderebilir misiniz?

dahey · 29 Eylül 2012

başkalarınında işine yarayabilir, bitmiş hali hala elinizdeyse gönderebilirmisiniz

Eğitmen o saatte müsait mi değil mi?

cems

cems

Levent Menteşoğlu

Administrator

Ekli dosyalar

cems

cems

Levent Menteşoğlu

Administrator

cems

cems

Levent Menteşoğlu

Administrator

cems

Levent Menteşoğlu

Administrator

cems

cems

Levent Menteşoğlu

Administrator

cems

cems

sherlockholmes

dahey