NOT Dağıtma
NOT Dağıtma
Merhaba arkadaşlar. Öğretmenlerin dönem sonunda yaptıkları dereceli ölçeklerde kullanılmak üzere öğrenciye verilen notu belli kriterlere göre rastgele bölen bir formül lazım. Örneğin: M4 hücresine 85 notu verildiğinde bu notu E4 F4 H4 Hücrelerine 1-10 aralığında, I4 J4 K4 L4 Hücrelerine 1-15 aralığında öyle rast gele bölmeli ki toplamları M4 hücresindeki rakamı versin. İnşallah anlatabilmişimdir. Ekteki dosyada eğer ile bazı çalışmalar yaptım ama istediğim gibi olmadı. Şimdiden teşekkürler.
Hüseyin Vurkan
Çözüm dosyası ektedir. Solver (Çözücü) ve makro ile yapılmıştır.
NOT:
38 altındaki notları dağıtamazsınız. Eğer dağıtımda 15’li olanlarda 10’un üstünde bir koşulunuz yoksa; aşağıdaki kodlarda kırmızı olarak işaretlediğim yerleri silin. Ya da başlarına bir tik ekleyin. Bu da 9’un altındaki notları dağıtmaz.
SolverReset Dim i As Long For i = 4 To 19 'satır sayısı arttıkça artacak SolverOk SetCell:="p" & i, MaxMinVal:=3, ValueOf:=0, ByChange:="$E$4:$L$19", _ Engine:=1, EngineDesc:="GRG Nonlinear" SolverAdd CellRef:="$E$4:$F$19", Relation:=1, FormulaText:="10" 'SolverAdd CellRef:="$G$4:$G$19", Relation:=3, FormulaText:="11" SolverAdd CellRef:="$G$4:$G$19", Relation:=1, FormulaText:="15" SolverAdd CellRef:="$H$4:$I$19", Relation:=1, FormulaText:="10" 'SolverAdd CellRef:="$J$4:$K$19", Relation:=3, FormulaText:="11" SolverAdd CellRef:="$J$4:$L$19", Relation:=1, FormulaText:="15" SolverAdd CellRef:="$E$4:$L$19", Relation:=4, FormulaText:="integer" SolverAdd CellRef:="$E$4:$L$19", Relation:=3, FormulaText:="1" SolverSolve userFinish:=True Next i SolverReset Paylaştır_3 End Sub
Sub Paylaştır_3() SolverReset Dim j As Long For j = 20 To 39 'satır sayısı arttıkça artacak SolverOk SetCell:="p" & j, MaxMinVal:=3, ValueOf:=0, ByChange:="$E$20:$L$39", _ Engine:=1, EngineDesc:="GRG Nonlinear" SolverAdd CellRef:="$E$20:$F$39", Relation:=1, FormulaText:="10" 'SolverAdd CellRef:="$G$20:$G$39", Relation:=3, FormulaText:="11" SolverAdd CellRef:="$G$20:$G$39", Relation:=1, FormulaText:="15" SolverAdd CellRef:="$H$20:$I$39", Relation:=1, FormulaText:="10" 'SolverAdd CellRef:="$J$20:$K$39", Relation:=3, FormulaText:="11" SolverAdd CellRef:="$J$20:$L$39", Relation:=1, FormulaText:="15" SolverAdd CellRef:="$E$20:$L$39", Relation:=4, FormulaText:="integer" SolverAdd CellRef:="$E$20:$L$39", Relation:=3, FormulaText:="1" SolverSolve userFinish:=True Next j SolverReset End Sub
Eğer bazı yerlere 0 vermeniz gerekecekse ve 9’un altında not verecekseniz, o zaman:
'SolverAdd CellRef:="$E$4:$L$19", Relation:=3, FormulaText:="1"
'SolverAdd CellRef:="$E$20:$L$39", Relation:=3, FormulaText:="1"
kodlarını da silin. Veya başlarına tik koyun.
Dosya:
Son Yorumlar