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.

Sub Paylaştır_2()
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:

Uygulama_Sinavi

You may also like...

Bir Cevap Yazın

E-posta hesabınız yayımlanmayacak. Gerekli alanlar * ile işaretlenmişlerdir

Şu HTML etiketlerini ve özelliklerini kullanabilirsiniz: <a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code> <del datetime=""> <em> <i> <q cite=""> <strike> <strong>