Hücredeki sayıyı diğer hücrelere dağıtma?

[hkaradag]

@Muhammet Okumuş Hocam teşekkür ederim. 20 soruluk analiz tablosunda for döngüsünü dediğiniz gibi değiştirdim kod çalıştı. Benzer değişiklik 25 soruluk tabloda maalesef çalışmıyor. Veriler E36:AC70 arasında. Hata nerede acaba?

Sub Dağıt()
Application.ScreenUpdating = False
Range("E36:AC70") = ""
son = Range("AD71").End(3).Row
For i = 36 To 70
If Cells(i, "AD") = "" Or Not IsNumeric(Cells(i, "AD")) Then GoTo 10
sayı = Range("AD" & i).Value
1
Range("E" & i & ":AC" & i) = Range("E35:AC35").Value
If sayı = 100 Then GoTo 10
5
a = WorksheetFunction.RandBetween(5, 29)
If Cells(i, a) < Cells(9, a) Then GoTo 5
Cells(i, a) = Cells(i, a) - Cells(9, a)
y = WorksheetFunction.Sum(Range("E" & i & ":AC" & i))
If sayı > y Then GoTo 1
If y <> sayı Then GoTo 5

10
Next
End Sub

 

[Muhammet Okumuş]

If Cells(i, a) < Cells(9, a) Then GoTo 5
Cells(i, a) = Cells(i, a) - Cells(9, a)


Burdaki 9ları 35 yapın.

 

[hkaradag]

Hocam ilginize çok çok teşekkür ederim, sağ olun gerçekten.

 

[Savklis]

Buradaki kodları 10 soruluk nasıl yapabilirim veya soru sayısı her sınavda değişklik gösterebiliyor soru sayısına göre nasıl değişklik yapabilirim.

Sub Dağıt()
Application.ScreenUpdating = False
Range("E10:AC47") = ""
son = Range("AD48").End(3).Row
For i = 10 To son
If Cells(i, "AD") = "" Or Not IsNumeric(Cells(i, "AD")) Then GoTo 10
sayı = Range("AD" & i).Value
1
Range("E" & i & ":AC" & i) = Range("E9:AC9").Value
If sayı = 100 Then GoTo 10
5
a = WorksheetFunction.RandBetween(5, 29)
If Cells(i, a) < Cells(9, a) Then GoTo 5
Cells(i, a) = Cells(i, a) - Cells(9, a)
y = WorksheetFunction.Sum(Range("E" & i & ":AC" & i))
If sayı > y Then GoTo 1
If y <> sayı Then GoTo 5

10
Next
End Sub

 

[Muhammet Okumuş]

Görseldeki konuma getirin.

AD olan yerler O harfi, AC olan yerleri ile değişin.
a = WorksheetFunction.RandBetween(5, 29)
29 yerine 14 yazın

 

[Savklis]

Teşekkürler

Sub Dağıt()
Application.ScreenUpdating = False
Range("E10:N47") = ""
son = Range("O48").End(3).Row
For i = 10 To son
If Cells(i, "O") = "" Or Not IsNumeric(Cells(i, "O")) Then GoTo 10
sayı = Range("O" & i).Value
1
Range("E" & i & ":N" & i) = Range("E9:N9").Value
If sayı = 100 Then GoTo 10
5
a = WorksheetFunction.RandBetween(5, 14)
If Cells(i, a) < Cells(9, a) Then GoTo 5
Cells(i, a) = Cells(i, a) - Cells(9, a)
y = WorksheetFunction.Sum(Range("E" & i & ":N" & i))
If sayı > y Then GoTo 1
If y <> sayı Then GoTo 5

10
Next
End Sub

AC yazan yelere N yazınca oldu.
Peki bu sayıların sıfır dahil rasgele olmasını sağlamak mümkün mü şu anda 10 ve 0 sayılarını veriyor sadece toplam verilen sayı olacak ve bazı sorulara 0 verecek şekilde değiştirilebilir mi. Mesela toplam 50 puan 10 0 2 8 4 6 0 10 3 7 gibi bir dağılım yapailir mi.

 

[Muhammet Okumuş]

If Cells(i, a) < Cells(9, a) Then GoTo 5
Cells(i, a) = Cells(i, a) - Cells(9, a)

kısmını

If Cells(i, a) =0 Then GoTo 5
Cells(i, a) = Cells(i, a) - 1

şeklinde değiştirin.

 

[Savklis]

Teşekkür ederim oldu. Belki başka ihtiyacı olan olur diye ekliyorum.

 

[guneyelt]

Hepinize hayırlı akşamlar . Kendi çapımda ufak tefek bir şeyler yapmaya çalışıyorum ve tıkandığım bir nokta var .
Öğretmenim ve ona göre bir örnekleme yapacağım.

1. Öğrencinin aldığı performans notunun bulunduğu hücreyi , 10 hücreye ( 10 kriter mevcut ) 5'in katları olacak şekilde nasıl rastgele dağıtabilirim ?
2. Eğer bu kriterler eşit puana sahip olmazsa ( bir kriter 10 diğeri 5 gibi ) bunu 1.maddeye nasıl uyarlayabilirim ?

beni aydınlatırsanız çok sevinirim üstatlarım .

 

[rb2344]

aşağıdaki şekilde makro ile, nota göre puanları dağıtmaya çalıştım ama hata veriyor. yardım edebilir misiniz?

 

[rb2344]

If Cells(i, a) < Cells(9, a) Then GoTo 5
Cells(i, a) = Cells(i, a) - Cells(9, a)

kısmını

If Cells(i, a) =0 Then GoTo 5
Cells(i, a) = Cells(i, a) - 1

şeklinde değiştirin.

bu dosyada hata alıyorum makro çalıştırınca. yardımcı olabilir misiniz?

 

[Muhammet Okumuş]

Bilgisayar yok yanımda. Müsait olduğumda bakabilirim.

 

[Savklis]

Al hocam
Range("E29:N29") = ""
son = Range("O69").End(3).Row
O69 kısmını 70 yapınca düzeldi bir de

If Cells(i, a) < Cells(9, a) Then GoTo 5
Cells(i, a) = Cells(i, a) - Cells(9, a)

kısmını

If Cells(i, a) =0 Then GoTo 5
Cells(i, a) = Cells(i, a) - 1

şeklinde değiştirdim böylece bazı sorulara sıfır puan veriyor.
Fakat istatistik kısmı sorunlu ortalama falan almıyor düzeltirseniz buraya eklermisiniz. belki başkalarıda yararlanır.

 

[rb2344]

Al hocam
Range("E29:N29") = ""
son = Range("O69").End(3).Row
O69 kısmını 70 yapınca düzeldi bir de

If Cells(i, a) < Cells(9, a) Then GoTo 5
Cells(i, a) = Cells(i, a) - Cells(9, a)

kısmını

If Cells(i, a) =0 Then GoTo 5
Cells(i, a) = Cells(i, a) - 1

şeklinde değiştirdim böylece bazı sorulara sıfır puan veriyor.
Fakat istatistik kısmı sorunlu ortalama falan almıyor düzeltirseniz buraya eklermisiniz. belki başkalarıda yararlanır.

If Cells(i, "O") = "" Or Not IsNumeric(Cells(i, "O")) Then kısmında hata veriyor. run-time error "13". type mismatch hatası veriyor

 

[rb2344]

birkaç not girip dağıt deyince de "a = WorksheetFunction.RandBetween(5, 14)" satırında hata veriyor.

 

[Savklis]

Ben hepsine 50 verip dağıt yapıyordum oluyordu... evet farklı notlar girince sıkıntı oluyor

 

[rb2344]

Ben hepsine 50 verip dağıt yapıyordum oluyordu... evet farklı notlar girince sıkıntı oluyor

çözümünüz var mı bununla alakalı?

 

[Muhammet Okumuş]

21. satırda ölçüt değerlerine göre verir.


Döngüyü 29 dan başlatın.

 

[rb2344]

Ekli dosyayı görüntüle 249477
21. satırda ölçüt değerlerine göre verir.

Ekli dosyayı görüntüle 249478
Döngüyü 29 dan başlatın.

çok teşekkür ederim.

 

[Savklis]

İstatistik ve analiz kısmınıda düzelterek ekliyorum, ihtiyacı olanlar için.