Toplamları belirli sayıya eşit olan sayı üretme

[ahmetozcan9211]

Excel üzerinde 30 adet rastgele sayı üretmek istiyorum ancak bu sayıların toplamı benim belirlediğim sayıya eşit olsun istiyorum. Birde mümkünse eğer bu sayılar benim belirlediğim sayılar arasında olsun istiyorum.
Örnek olarak şu şekilde açıklayabilirim.
Toplamda ulaşmak istediğim sayı 2733 olsun. 30 adet sayı üretip toplamlarının 2733 olmasını istiyorum. Ve bu sayıların 70 ile 100 arasında olmasını istiyorum.
Yardımcı olur musunuz

 

[Muzaffer Ali]

Merhaba.

Aşağıdaki kodları bir modüle kopyalayın.

Test kodlarını çalıştırın.

Sub test()
    Dim Alt As Long
    Dim Ust As Long
    Dim Toplam As Long
    Dim RakamAdeti As Long
    
    Alt = InputBox("Alt: Alt sınırı giriniz." & vbLf & "Üst:" & vbLf & "Toplam:" & vbLf & "Rakam Adeti:")
    Ust = InputBox("Alt: " & Alt & vbLf & "Üst: Üst sınırı giriniz." & vbLf & "Toplam:" & vbLf & "Rakam Adeti:")
    Toplam = InputBox("Alt: " & Alt & vbLf & "Üst: " & Ust & vbLf & "Toplam: Ulaşmak istediğiniz toplam rakamı giriniz." & vbLf & "Rakam Adeti:")
    RakamAdeti = InputBox("Alt: " & Alt & vbLf & "Üst: " & Ust & vbLf & "Toplam: " & Toplam & vbLf & "Rakam Adeti: Kaç rakam kullanmak istediğinizi giriniz.")
    
    Rastgele Alt, Ust, Toplam, RakamAdeti

End Sub

Sub Rastgele(Alt As Long, Ust As Long, Toplam As Long, RakamAdeti As Long)
    Dim Deger As Long
    Dim Bak As Long
    Dim Sira As Long
    If Alt = Ust Then
        MsgBox "Alt sınır ile üst sınır aynı olamaz."
        Exit Sub
    ElseIf Alt > Ust Then
        MsgBox "Alt sınır üst sınırdan büyük olamaz."
        Exit Sub
    ElseIf Toplam < (RakamAdeti * Alt) Then
        MsgBox "Belirttiğiniz alt sınır ve belirttiğiniz rakam adeti ile " & Toplam & " rakamına ulaşılamaz."
        Exit Sub
    ElseIf Toplam > (RakamAdeti * Ust) Then
        MsgBox "Belirttiğiniz üst sınır ve belirttiğiniz rakam adeti ile " & Toplam & " rakamına ulaşılamaz."
        Exit Sub
    End If
    
    For Bak = 1 To RakamAdeti
        Deger = WorksheetFunction.RandBetween(Alt, Ust)
        Cells(Bak, "A") = Deger
    Next
    Sira = 0
    Do While WorksheetFunction.Sum(Range("A:A")) < Toplam
        Sira = 1 + Sira
        If Sira > RakamAdeti Then Sira = 1
        If Cells(Sira, "A") < Ust Then Cells(Sira, "A") = Cells(Sira, "A") + 1
    Loop
    
    Do While WorksheetFunction.Sum(Range("A:A")) > Toplam
        Sira = 1 + Sira
        If Sira > RakamAdeti Then Sira = 1
        If Cells(Sira, "A") > Alt Then Cells(Sira, "A") = Cells(Sira, "A") - 1
    Loop
End Sub

 

[Muhammet Okumuş]

Sn. dalgalıkur;
Userform ile sayfa üzerinden veriler alınarak daha kullanışlı hale getirilebilir.

 

[Muzaffer Ali]

Sn. dalgalıkur;
Userform ile sayfa üzerinden veriler alınarak daha kullanışlı hale getirilebilir.

Evet farklı yöntemlerle veriler alınabilir. Ben bu şekilde tercih ettim.