• DİKKAT

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

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

@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?
Kod: 
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
 
If Cells(i, a) < Cells(9, a) Then GoTo 5
Cells(i, a) = Cells(i, a) - Cells(9, a)


Burdaki 9ları 35 yapın.
 
Hocam ilginize çok çok teşekkür ederim, sağ olun gerçekten.
 
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
Genişletmek için tıkla ...
 

Ekli dosyalar

248057
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
 
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
Genişletmek için tıkla ...

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.
 

Ekli dosyalar

  • Screenshot_1.png
    Screenshot_1.png
    5.6 KB · Görüntüleme: 6
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.
 
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 .
 
aşağıdaki şekilde makro ile, nota göre puanları dağıtmaya çalıştım ama hata veriyor. yardım edebilir misiniz?
 

Ekli dosyalar

Muhammet Okumuş' Alıntı:
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.
Genişletmek için tıkla ...

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

Ekli dosyalar

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.
 

Ekli dosyalar

Son düzenleme:
Savklis' Alıntı:
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.
Genişletmek için tıkla ...
If Cells(i, "O") = "" Or Not IsNumeric(Cells(i, "O")) Then kısmında hata veriyor. run-time error "13". type mismatch hatası veriyor
 
birkaç not girip dağıt deyince de "a = WorksheetFunction.RandBetween(5, 14)" satırında hata veriyor. 249416
 
Ben hepsine 50 verip dağıt yapıyordum oluyordu... :) evet farklı notlar girince sıkıntı oluyor
 

Ekli dosyalar

  • Screenshot_1.png
    Screenshot_1.png
    94.8 KB · Görüntüleme: 5
249477
21. satırda ölçüt değerlerine göre verir.

249478
Döngüyü 29 dan başlatın.
 
İstatistik ve analiz kısmınıda düzelterek ekliyorum, ihtiyacı olanlar için.
 

Ekli dosyalar

Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst