• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Uygulamalı sınav ölçekleri

Katılım
12 Ağustos 2007
Mesajlar
301
Excel Vers. ve Dili
2003 türkçe
2016 türkçe
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.


http://s3.dosya.tc/server10/0azt1i/Uygulama_Sinavi.xlsm.xlsx.html
 
excel not dağıtma olarak araştırın, benzerl çalışmaları forumda bulabilirsiniz.
 
Bunlarda benim yaptığım dağıtım programları. İnceleyip olumlu veya olumsuz özelliklerini söylerseniz memnun olurum. Dağıtımı makrolu da makrosuz olanda rastgele yapıyor.
 

Ekli dosyalar

Sayın muygun ve sayın İdris ilginize teşekkür ediyorum çözümlerinizi kullanmaya çalışacağım. Ancak Sayın İdris Hocam Sizin gönderdiğiniz çözümde not 38 in altına döşerse doğru dağıtım yapmıyor. Sayın mrwarrior sizin eklerinizi indirip inceleyemedim. Altın üyelik istiyor. Teşekkürler
 
Son düzenleme:
Sayın muygun ve sayın İdris ilginize teşekkür ediyorum çözümlerinizi kullanmaya çalışacağım. Ancak Sayın İdris Hocam Sizin gönderdiğiniz çözümde not 38 in altına döşerse doğru dağıtım yapmıyor. Sayın mrwarrior sizin eklerinizi indirip inceleyemedim. Altın üyelik istiyor. Teşekkürler

.

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.

Kod:
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"
   [COLOR="red"] 'SolverAdd CellRef:="$G$4:$G$19", Relation:=3, FormulaText:="11"[/COLOR]
    SolverAdd CellRef:="$G$4:$G$19", Relation:=1, FormulaText:="15"
    SolverAdd CellRef:="$H$4:$I$19", Relation:=1, FormulaText:="10"
   [COLOR="red"] 'SolverAdd CellRef:="$J$4:$K$19", Relation:=3, FormulaText:="11"[/COLOR]
    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

Kod:
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"
   [COLOR="Red"] 'SolverAdd CellRef:="$G$20:$G$39", Relation:=3, FormulaText:="11"[/COLOR]
    SolverAdd CellRef:="$G$20:$G$39", Relation:=1, FormulaText:="15"
    SolverAdd CellRef:="$H$20:$I$39", Relation:=1, FormulaText:="10"
   [COLOR="red"] 'SolverAdd CellRef:="$J$20:$K$39", Relation:=3, FormulaText:="11"[/COLOR]
    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

Bu kodlarla da 9'dan aşağı not dağıtamazsınız.

Eğer bazı yerlere 0 vermeniz gerekecekse ve 9'un altında not verecekseniz, o zaman:

Kod:
[COLOR="Red"]'SolverAdd CellRef:="$E$4:$L$19", Relation:=3, FormulaText:="1"

 'SolverAdd CellRef:="$E$20:$L$39", Relation:=3, FormulaText:="1"

[/COLOR]

kodlarını da silin. Veya başlarına tik koyun.


.
 
Sayın İdris Hocam söylediğiniz değişikleri yapınca çok güzel oldu. Emeğinize sağlık. Yanlız bu dosyayı kendi dosyama uygulayınca aşırı derecede yavaş çalışıyor. Kullanıcılığı kalmıyor. Bu makroyu hızlandırmanın bir yolu var mı acaba. Çünkü e okuldan aldığım notları işlediğim bir çalışmama uygulamak istiyorum. Taşı veya kopyala dediğimde uygun olmayan satır ve sütun sayıları olduğunu belirten bir mesaj alıyorum. Kopyala yapıştır ile taşıdığımda makro SolverReset satırında hata veriyor. Bir türlü çözemedim.Bir de Not girilmeyen satırlar: 1 1 11 1 1 11 11 1 şeklinde dolu kalıyor. Bu satırların boş olması için nasıl bir ek yapmalı acaba? Teşekkürler.
 
Son düzenleme:
Geri
Üst