- Katılım
- 28 Eylül 2007
- Mesajlar
- 4,017
- Excel Vers. ve Dili
- 2013 Türkçe
Yok Hocam estağfurullah. İnternet bulmakta zorlandığım için cevap veremiyorum. Yoksa ne yanlışlığı olsun.
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sn olixi,Hocam bundan önceki uygulama iyiydi, (Yeni Kura 2) şimdi uygulamada grup olarak 1 grup seçsek tüm öğrenciler için kura bir defada homojen bir kura yapsak kız-erkek ve yaş dağılımını eşit yapar mı(örneğin 66 aylı 26 öğrenci varsa ve 13 sınıf olacaksa her sınıfıa 2 adet 66 aylık öğrenci gelecek şekilde) şeklinde bir dağılım mümkünse öyle yapalım hocam liste oluştuğunda listelerde de yine ay olarak yaş grubu da gözüksün en iyisi bu
hocam siz bunu denediniz mi?birde dikkat sayfasına istediğimiz kadar öğrenci yazma işini nasıl yapacağız?Hocam dikkat sayfasına da istediğiniz kadar öğrenci yazabilirsiniz. Üçüz için ise A-B-C üçüz olsun. A-B yanyana, A-C bir alt satıra yan yana yazınız.
Hocam hata sizin 3 öğrenciyi iki farklı öğretmene tercih etmenizden kaynaklanıyor.muokumuş program gayet güzel çalışıyor.fakat bir yerde sıkıntı var.şimdi mesela bizde 5 öğrenci aynı anda bir sınıf istemiş.dikkat sayfasında sadece 2 öğrenci yazabildiğimiz için bende bunları tercihli listesinde gösterdim.fakat sınıflara dağıtırken dikkat sayfasında bir sıkıntı yok.gayet güzel dağıttı.fakat tercihlilerin bazılarını tercih dışı dağıttı.örneğin yusuf yusufoğullarından adlı öğrenciyi ben tercihli listesinde nurcan erol a verdim fakat o nesrin çittir da gözüküyor.yine elif su aytekin fatma nur sarı da olması gerekirken başka öğretmene verilmiş.dosyayı ekledim.
muokumuş hocam bu yeni eklediğiniz dosya yenikura5 dosyası ile aynı sadece kaydırma çubuğu var değil mi fark olarak.Sn olixi dosyayı oluşturdum. Kura sayfasına kaydırma çubuğu ekledim. Onunla kurayı hızlandırabilirsiniz.
108.nolu mesajınızı mı güncellediniz?şubeleri yaşlara göre dağılım yaptım. Istek üzerine.
Hocam değişiklik yok demiştiniz. Onun için yazdım.muokumuş hocam bu yeni eklediğiniz dosya yenikura5 dosyası ile aynı sadece kaydırma çubuğu var değil mi fark olarak.
Kodu değiştiriniz.Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("F3:F22")) Is Nothing Then Exit Sub
Dim son, mük, sut, sayılan, cvp, k As Byte
Dim sat As Integer
Application.ScreenUpdating = False
If ActiveCell.Value = "" Then Exit Sub
If Target.Count > 1 Then Exit Sub
Sheets("Tercih").Visible = True
Sheets("Dikkat").Visible = True
son = Range("C100").End(3).Row + 1
mük = WorksheetFunction.CountIf(Range("C3:C100"), ActiveCell.Value)
If mük = 1 Then cvp = MsgBox(ActiveCell.Value & " daha önceden şube ataması yapıldı. Lütfen bilgilerinizi kontrol ediniz", vbInformation, "Uyarı")
If cvp = vbOK Then Exit Sub
Cells(son, 3) = ActiveCell.Value
sayılan = WorksheetFunction.CountA(Range("C3:C100"))
If sayılan = Sheets("Grup").Range("C3").Value Then
Range("C3:C22").Copy
Sheets("Kura").Range("C7").PasteSpecial (xlPasteValues), Transpose:=True
Sheets("Kura").Range(Sheets("Kura").Cells(9, 3), Sheets("Kura").Cells(9, 2 + Sheets("Grup").Range("C3").Value)) = "=Grup!$C2 & ""/"" & SUBSTITUTE(ADDRESS(ROW(),COLUMN(A1),4),ROW(),"""") & "" Şubesi"""
Sheets("Kura").Range(Sheets("Kura").Cells(9, 3), Sheets("Kura").Cells(9, 2 + Sheets("Grup").Range("C3").Value)) = Sheets("Kura").Range(Sheets("Kura").Cells(9, 3), Sheets("Kura").Cells(9, 3 + Sheets("Grup").Range("C3").Value)).Value
Sheets("Kura").Range(Sheets("Kura").Cells(9, 3), Sheets("Kura").Cells(9, 2 + Sheets("Grup").Range("C3").Value)).Borders.LineStyle = 1
Sheets("Kura").Range(Sheets("Kura").Cells(9, 3), Sheets("Kura").Cells(9, 2 + Sheets("Grup").Range("C3").Value)).Interior.ColorIndex = 4
Sheets("Kura").Range(Sheets("Kura").Cells(7, 3), Sheets("Kura").Cells(7, 2 + Sheets("Grup").Range("C3").Value)).Borders.LineStyle = 1
Sheets("Kura").Range(Sheets("Kura").Cells(7, 3), Sheets("Kura").Cells(7, 2 + Sheets("Grup").Range("C3").Value)).Interior.ColorIndex = 36
Sheets("Kura").Range(Sheets("Kura").Cells(11, 3), Sheets("Kura").Cells(10 + Sheets("Grup").Range("L7").Value, 2 + Sheets("Grup").Range("C3").Value)).Borders.LineStyle = 1
Sheets("Kura").Range(Sheets("Kura").Cells(5, 3), Sheets("Kura").Cells(5, 2 + Sheets("Grup").Range("C3").Value)).Merge
Sheets("Kura").Range(Sheets("Kura").Cells(5, 3), Sheets("Kura").Cells(5, 2 + Sheets("Grup").Range("C3").Value)).Interior.ColorIndex = 1
Sheets("Kura").Range(Sheets("Kura").Cells(10, 3), Sheets("Kura").Cells(10, 2 + Sheets("Grup").Range("C3").Value)) = "'"
Sheets("Kura").Range(Sheets("Kura").Cells(5, 3), Sheets("Kura").Cells(5, 2 + Sheets("Grup").Range("C3").Value)).Borders.LineStyle = 1
Sheets("Tercih").Select
Call Tercih_Değiş
Sheets("Dikkat").Select
Call İkiz
Call İkiz1
Call Zıt
Call Zıt1
Sheets("Kura").Select
Sheets("Kura").Range("C5").Select
sat = 10 + Sheets("Grup").Range("L7").Value
sut = 2 + Sheets("Grup").Range("C3").Value
With Sheets("Kura").Range(Sheets("Kura").Cells(11, 3), Sheets("Kura").Cells(sat, sut)).FormatConditions.Add(xlExpression, xlEqual, "=$C$5=C11")
With .Interior
.ColorIndex = 6
End With
With .Font
.ColorIndex = 1
.Bold = True
End With
End With
With Sheets("Kura").Range(Sheets("Kura").Cells(11, 3), Sheets("Kura").Cells(sat, sut)).FormatConditions.Add(xlExpression, xlEqual, "=DÜŞEYARA(C11;Liste!$D$3:$H$1000;5;0)=""ERKEK""")
With .Interior
.ColorIndex = 5
End With
With .Font
.ColorIndex = 2
.Bold = True
End With
End With
With Sheets("Kura").Range(Sheets("Kura").Cells(11, 3), Sheets("Kura").Cells(sat, sut)).FormatConditions.Add(xlExpression, xlEqual, "=DÜŞEYARA(C11;Liste!$D$3:$H$1000;5;0)=""KIZ""")
With .Interior
.ColorIndex = 3
End With
With .Font
.ColorIndex = 2
.Bold = True
End With
End With
Sheets("Grup").Range("BK4:BK" & Sheets("Grup").Range("C6") + 3) = "=RAND()"
Sheets("Grup").Range("BC4:BK" & Sheets("Grup").Range("C6") + 3).Sort Key1:=Sheets("Grup").Range("BK4"), ORDER1:=xlAscending
Sheets("Grup").Range("BK4:BK" & Sheets("Grup").Range("C6") + 3) = ""
Sheets("Kura").Range("C5") = " "
End If
Sheets("Tercih").Visible = False
Sheets("Dikkat").Visible = False
End Sub