DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
muhammet kardeş bu çizelge bana uyar fakat bunda birkaç düzenleme lazım.önce kura sayfasında düzenle düğmesine basınız daha sonra kura ve öğretmen ata düğmesini kullanabilirsiniz.
Hocam sizin için ayrı bir dosya oluşturmak lazım. Bu dosya üzerinde baya bir değişiklik yaptım. (istek üzerine) Artık kodalrın nereye, neden komut verdiğini ben de karıştırır oldum. Kusura bakmayın ama şu an hazırlamam pek mümkün görünmüyor.muhammet kardeş bu çizelge bana uyar fakat bunda birkaç düzenleme lazım.
1-düzenle butonu hata veriyor.
2-şube sayısnı nasıl düzenleyeceğiz.
3-birde sizin son mesaja eklemiş olduğunuz gibi öğrenci listesi oluşturulmalı.
4-birde bizde öğretmen tercihi yok bazı öğrenciler komşu çocuğu akraba kardeş gibi bunların aynı sınıfta olması lazım
5-öğretmenler kura ile belirlenecek burası kalsın.
6-birde 2006 doğumlular bir sınıfta 2007 liler bir sınıfta olacak şekilde.yani 2006 lı 140 öğrenci sayıları eşit olacak şekilde dağıtacak.sınıf sayıları ve sınıflardaki kız erkek öğrenci sayıları eşit olacak.
Düzen makrosunu bununla değişin yadaSub Düzen()
Dim ÖS, sonn As Byte
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Do Until Sheets.Count = 6
Sheets(Sheets.Count).Delete
Loop
Call Temizle
Sheets("Taslak").Visible = True
Sheets("Tercihli").Visible = True
Dim Son, kac, adet As Byte
Range("A1:B1") = ""
Range("D1100") = ""
Range("B31000") = ""
Range("I4:Z1000") = ""
ActiveWindow.ScrollColumn = 5
ÖS = Sheets("Öğretmenler").Range("F100").End(3).Row
Sheets("Öğretmenler").Range("F3:F" & ÖS).Copy
Sheets("Taslak").Range("I5").PasteSpecial (xlPasteValues), Transpose:=True
Application.CutCopyMode = False
Sheets("Taslak").Select
Call Kura_Oluştur
Sheets("Kura").Select
Son = Sheets("Liste").Range("B1000").End(3).Row
Range(Cells(6, 9), Cells(6, 8 + Range("F2").Value)) = "=$F3 & ""/"" & SUBSTITUTE(ADDRESS(ROW(),COLUMN(A1),4),ROW(),"""") & "" Şubesi"""
Range(Cells(6, 9), Cells(6, 8 + Range("f2").Value)) = Range(Cells(6, 9), Cells(6, 8 + Range("F2").Value)).Value
Range(Cells(4, 9), Cells(4, 8 + Cells(2, 6))).Merge
Range(Cells(4, 9), Cells(4, 8 + Cells(2, 6))).Borders.LineStyle = 1
Range(Cells(6, 9), Cells(6, 8 + Cells(2, 6))).Interior.ColorIndex = 4
adet = WorksheetFunction.RoundUp(Son / Cells(2, 6), 0)
Range(Cells(6, 9), Cells(5 + adet, 8 + Cells(2, 6))).Borders.LineStyle = 1
Range("I4") = " "
Range("I4").Interior.ColorIndex = 6
With Range(Cells(7, 9), Cells(5 + adet, Cells(2, 6) + 8)).FormatConditions.Add(xlExpression, xlEqual, "=$I$4=I7")
With .Interior
.ColorIndex = 6
End With
With .Font
.ColorIndex = 1
.Bold = True
End With
End With
With Range(Cells(7, 9), Cells(5 + adet, Cells(2, 6) + 8)).FormatConditions.Add(xlExpression, xlEqual, "=DÜŞEYARA(I7;Liste!$B$3:$C$2000;2;0)=""KIZ""")
With .Interior
.ColorIndex = 3
End With
With .Font
.ColorIndex = 2
.Bold = True
End With
End With
With Range(Cells(7, 9), Cells(5 + adet, Cells(2, 6) + 8)).FormatConditions.Add(xlExpression, xlEqual, "=DÜŞEYARA(I7;Liste!$B$3:$C$2000;2;0)=""ERKEK""")
With .Interior
.ColorIndex = 5
End With
With .Font
.ColorIndex = 2
.Bold = True
End With
End With
Sheets("Öğretmenler").Select
Sheets("Taslak").Visible = False
Sheets("Tercihli").Visible = False
End Sub