تولید اعداد رندوم با یک میانگین مشخص

[~M*E*H*D*I~]

درود

از طریق کد زیر 4 عدد رندوم با میانگین 70 تولید خواهد شد :

Sub Macro1()
a:
DoEvents
For i = 1 To 4
    Cells(1, i) = Round(Rnd(1) * 100)
Next i

If WorksheetFunction.Average(Range("a1:d1").Value) = 70 Then
    MsgBox "OK"
    Exit Sub
Else
    GoTo a
End If
End Sub 

اخطار: این یک موضوع قدیمی است به دلیل قدیمی بودن موضوع، ممکن است برخی فایل های ضمیمه به درستی کار نکنند. لطفا در صورت عدم ضرورت، از بالا آوردن موضوعات قدیمی خودداری نمایید.

[Amir Ghasemiyan]

اگه اون چهار عدد نتونن ميانگين مورد نظر رو بسازن تكليف چيه؟

[~M*E*H*D*I~]

اگه اون چهار عدد نتونن ميانگين مورد نظر رو بسازن تكليف چيه؟

این اتفاق نمیفته و حتما باید میانگین ساخته بشه تا کد متوقف بشه

[Amir Ghasemiyan]

این اتفاق نمیفته و حتما باید میانگین ساخته بشه تا کد متوقف بشه

خب ميدونم. مثلا اگه طرف ميانگين رو بزنه -10 اونوقت چي؟

[~M*E*H*D*I~]

خب ميدونم. مثلا اگه طرف ميانگين رو بزنه -10 اونوقت چي؟

Sub Macro1()
a:
DoEvents
For i = 1 To 4
    Cells(1, i) = Round(Rnd(1) * -100)
Next i

If WorksheetFunction.Average(Range("a1:d1").Value) = -10 Then
    MsgBox "OK"
    Exit Sub
Else
    GoTo a
End If
End Sub 

[Amir Ghasemiyan]

Sub Macro1()
a:
DoEvents
For i = 1 To 4
    Cells(1, i) = Round(Rnd(1) * -100)
Next i

If WorksheetFunction.Average(Range("a1:d1").Value) = -10 Then
    MsgBox "OK"
    Exit Sub
Else
    GoTo a
End If
End Sub 

دستت درد نكنه ولي اينم يه مشكلي داره :دي
اگه عدد ميانگين مثبت باشه جواب نميده

بذار يه كد بنويسم كه هر عددي بدي پوشش ميده

[Amir Ghasemiyan]

با اجازه استاد وطن پرست.
الان ميدونم چه حرصي ميخوره از دست من
اين كد براي هر عددي جواب ميده.مثبت، منفي و حتي صفر
اگه كسي بلده كد كوتاه تري بنويسه خوشحال ميشم اينجا به اشتراك بذاره

Sub Macro1()
Dim ave As Integer


ave = 10


If ave < 0 Then
    n1 = 1
    n2 = 1
ElseIf ave > 0 Then
    n1 = 2
    n2 = 2
Else
    n1 = 1
    n2 = 2
End If


a:
DoEvents
For i = 1 To 4 Step 2
    Cells(1, i) = Round(Rnd(1) * 100 * (-1) ^ n1)
    Cells(1, i + 1) = Round(Rnd(1) * 100 * (-1) ^ n2)
Next i


If WorksheetFunction.Average(Range("a1:d1").Value) = ave Then
    MsgBox "OK"
    Exit Sub
Else
    GoTo a
End If


End Sub