Otomatik Toplama

[qazxswedc321]

Merhaba,
Kişilerin performanslarını değerlendirmek için 8 kategoriden oluşturulmuş bir sistem var. Bu kategorilerden 7 tanesine 0-10 arası 1 tanesi de 0-30 arası puan verilebilmektedir. Toplam puan en fazla 100 oluyor.
Ben sadece toplam puanı girip kategorilere belirtilen değer aralığında otomatik çift sayılar atanmasını istiyorum (kategorilerin toplamı benim verdiğim toplam puana eşit olacak). Uğraştım ancak işin içinden çıkamadım.
Ekte örnek excel dosyası mevcuttur.
Yardımcı olabilirseniz çok sevinirim.
İyi çalışmalar dilerim.

 

[Zeki Gürsoy]

Ekli dosyayı inceleyin.

[SIZE=2]Sub demo()
    Randomize Timer
    
    son = [j100].End(3).Row
    
    If son = 1 Then Exit Sub
    
    For i = 2 To son
    
        Do
            DoEvents
            For j = 2 To 8
                Do
                    Cells(i, j) = Int(Rnd * 11)
                    If Cells(i, j) Mod 2 = 0 Then Exit Do
                Loop
            Next
            
            Cells(i, 9) = Cells(i, 10) - WorksheetFunction.Sum(Range("b" & i & ":h" & i))
            
            If Cells(i, 9) >= 0 And Cells(i, 9) <= 30 And Cells(i, 9) Mod 2 = 0 Then Exit Do
            
        Loop
    
    Next
    
    MsgBox "Bitti", vbInformation
End Sub[/SIZE]

 

[qazxswedc321]

Sayın 'Zeki Gürsoy';
Yardımınız için çok teşekkür ederim.
Ancak deneme yaptığımda bazı değerlerin negatif (-) olduğunu gördüm, bunu düzeltmemiz mümkün müdür?
İyi çalışmalar

 

[Zeki Gürsoy]

Düzelttim; dosyayı tekrar indirip deneyin.