Öğrenciye verilen notları değerlendirme ölçütlerine göre dağıtmak

[filito]

Arkadaşlar merhaba,
Ben ekte gönderdiğim excel dosyasında mesela öğrenciye 85 vediğimde değerlendirme kriterleri olan 10 sütunda notlar oraya dağıtılsa. Ama bu dağıtılma her öğrencide farklı olsa yani aynı olmasa. Böyle bir formül yazılabilir mi? Her sütunda maksimum 10 puan barajı olacak. Ben tek bir formül yazabilirim ama böyle daha farklı bir formül var mı? not dağılımını her öğrencide farklı yapacak?

 

[turist]

Dosyanızda M sütununa puan verdiğinizi varsayarsak;
Örnek 16 No.lu öğrenciye 85 puan verdiğinizde her değerlenidrme eşit olarak 8,5 puan mı olacak veya başka bir dağıtım kriteri var mı?

Cevaplamanıza göre daha kolay yardım alabilirsiniz.

 

[Muhammet Okumuş]

Merhaba,

Sub Dağıt()
Application.ScreenUpdating = False
son = Cells(Rows.Count, "M").End(3).Row
For i = 4 To son
Range("C" & i & ":L" & i) = 10
20
If WorksheetFunction.Sum(Range("C" & i & ":L" & i)) = Range("M" & i) Then GoTo 10
5
Randomize
a = Int(Rnd() * 10 + 3)
If Cells(i, a) = 0 Then GoTo 5
Cells(i, a) = Cells(i, a) - 1
GoTo 20
10
Next
End Sub

Dosyayı inceleyiniz.

 

[filito]

Dosyanızda M sütununa puan verdiğinizi varsayarsak;
Örnek 16 No.lu öğrenciye 85 puan verdiğinizde her değerlenidrme eşit olarak 8,5 puan mı olacak veya başka bir dağıtım kriteri var mı?

Cevaplamanıza göre daha kolay yardım alabilirsiniz.

Hocam merhaba, değerlendirme eşit olmayacak farklı olacak. Ve aynı zamanda mesela iki öğrenci de 85 almışsa herbirinin değerlendirme puanları farklı olacak. Yani M sütununa puan tüm öğrencilere 85 girdiğimde tüm öğrencilerde puanlama kriteri farklı olacak. İnşaallah anlatabilmişimdir.

 

[filito]

Merhaba,

Dosyayı inceleyiniz.

Muhammet Bey merhaba,
excelde sizin seviyenize göre çok çok acemiyim. Verdiğiniz dosyayı inceledim şayet bir formül felan görmedim. Makro eklenmiş sanırım. Makroları aktif ettim. M sütununa puan girdiğimde not dağılımı olmuyor. Ya da ben yapamadım.

 

[Muhammet Okumuş]

M sütununa değerleri girip makroyu çalıştırınız

 

[Muhammet Okumuş]

Dosyayı bilgisayarınıza kaydedin. Sonra deneyin. Aç diyerek deneme yapmayın.

 

[filito]

Muhammet Bey dediğiniz gibi yaptım. Bilgisayara kaydettim dosyayı. Dosyayı açtım. M sütununa notları girdim. Son olarak da makroları etkinleştirdim ama herhangi bir değişim olmadı. Yani puanlama olmadı. Acaba eksik yaptığım bir şey mi var?

 

[Muhammet Okumuş]

Yapamadığınız dosyayı ekleyiniz?

 

[filito]

Buyrun Muhammet Bey.

 

[Muhammet Okumuş]

Hocam dosyada bir sıkıntı yok.
Eğer Dağıt düğmesine bastığınızda uyarı veriyorsa;
Dağıt düğmesinin üzerine sağ tıklayıp, Makro Ata seçip Dağıt yazan kısmı işaretlemeniz yeterli olacak.

 

[filito]

Allah razı olsun. Çok teşekkürler. Şimdi oldu. Bu arada ben yukarıdaki değerlendirme kriterlerini değiştirsem ya da sütun ekleyip çıkarsam hata verir mi?

 

[Muhammet Okumuş]

Hata verir.

 

[filito]

Evet veriyormuş Peki Muhammet Bey, bunun mantığını anlatmanız çok mu uzun sürer. Hani başka bir form yaparken ben kendim yapsam en azından sizleri bunun için bir daha rahatsız etmem. Çok karmaşık değilse nasıl yaptığınızı anlatmanız mümkün mü? Çok uzun sürecekse ve çok karmaşıksa anlatmayın Ben sadece ufak tefek excel formülleri yapıp işimi halledecek kadar bilgiye sahibim. Anlatsanız da anlamam sanırım. Anlayışınız için şimdiden teşekkürler...

Not: Aynı anda yazmışız nerdeyse. Yazınızı görmemiştim.

 

[Muhammet Okumuş]

Mantığını yarın açıklayayım.

 

[Muhammet Okumuş]

Sub Dağıt()
Application.ScreenUpdating = False -- İşlem yaparken gözükmesin.

son = Cells(Rows.Count, "M").End(3).Row -- M sütunundaki son dolu satırı bul

For i = 4 To son -- 4 ile son arasını döngüye al.

Range("C" & i & ":L" & i) = 10 -- C ile L i satır numarasını 10 ile doldur. Bunlar ölçüt puanları. Değişken ölçütler için bu kısma başka kod yazılabilir.


20

If WorksheetFunction.Sum(Range("C" & i & ":L" & i)) = Range("M" & i) Then GoTo 10 -- eğer c ile l arası toplam M ye eşit ise 10 yazan satıra git.

5

Randomize
a = Int(Rnd() * 10 + 3) -- 3 ile 12 arası sayı üret ( c sütun numarası 3, L sütun numarası 12)

If Cells(i, a) = 0 Then GoTo 5 ' eğer hücre değeri sıfır ise 5 yazan yere git. Başka sayı bulmasını istiyoruz.

Cells(i, a) = Cells(i, a) - 1 -- Hücre değerinden 1 çıkartıyoruz. Örneğin 4. satır için rastgele bulunan sayı 5 olsun. Bu e sütunu demektir. Eğer e4 = 0 değilse e4 değerinden 1 çıkar.

GoTo 20 -- 20 yazan yere git.
10
Next
End Sub

 

[ahmett46]

Sayın Okumuş Bu 10 kriteri mesela 7 kritere indirdiğimizde ve her kriteri farklı puanlarla değerlendirme yapmak istediğimizde mesela 1. kriter 5 puan 2. kriter 10 puan gibi puanlarla değerlendirme yapacak olursak böyle bir makro ile dağıtmamız mümkün olacak mı? teşekkürler

 

[Muhammet Okumuş]

Mümkündür. "Rastgele seçim yaptırma" diye bir konu var aktif ekranda. O dosyayı iceleyiniz.

 

[filito]

Muhammet Bey çok açıklayıcı olmuş teşekkür ederim. 9 sütunlu bir dosyamda denedim oldu. Allah razı olsun. Farklı puanlama sisteminde de denedim yaptım.

1-Son olarak şunları sormak istiyorum "0" sıfır değerini vermemesi için (en az 1 versin) nasıl bir ekleme ya da düzeltme yapabiliriz. 5-c proje dosyayı ekledim. Bu dosya üzerinde yapıp onu da açıklarsanız bana çok yardımcı olmuş olacaksınız.

2-Ve ikinci proje değerlendirme dosyasında da şu satırda hata diyor. Satırda ne istediğini anlamadığım için birşey yapamadım. Daha önce yaptığınız açıklamaya baktım ama bir şey anlamadım açıkcası.
"Cells(i, a) = Cells(i, a) - 1

 

[Muhammet Okumuş]

Cells(i, a) = Cells(i, a) - 1

ile 5 verdiğiniz değerlerden 1 düşüyor.

Cells(i, a) = Cells(i, a) - 2 yaparsanız ikişer ikişer düşer.



If Cells(i, a) = 0 Then GoTo 5 bu ifadeki 0 değeri en küçük değere kadar düşer. Sıfır değerini 1 yaparsanız minumum 1 değeri olur.