پرسش تولید n عدد تصادفی بین a و b برای رسیدن به میانگین مورد نظر در m سطر

[art1364]

تولید n عدد تصادفی بین a و b برای رسیدن به میانگین مورد نظر در m سطر
سلام
فرض کنید در ستون Z اکسل با m سطر، میانگین های مورد نظر من هستن
حال یک ماکرو می خوام که n (n حداکثر 20)عدد صحیح را در بازه a و b تولید کنه به طوریکه اختلاف میانگین اعداد تولید شده با میانگین مورد نظر (mi) در بازه (0.15+، 0.15-) باشه.
ممنون میشم مثل همیشه راهنمایی نمایید.
در ضمن یک کد پیدا کردم مشابه هست ولی به کار من نمی یاد شاید بشه دستکاری کرد تا به نتیجه دلخواه من برسه.

()Sub RandomGenerator
Dim min, max, cnt As Variant

Do While True
min = InputBox("Set the minimum", "Generating random with average", 25)
If min = "" Then Exit Sub
If Not IsNumeric(min) Then
MsgBox "Minimum has to be an integer. Try again.", vbExclamation, "Wrong input"
ElseIf CInt(min) <= 0 Then
MsgBox "Minimum has to be a positive integer. Try again.", vbExclamation, "Wrong input"
Else
Exit Do
End If
Loop

Do While True
max = InputBox("Set the maximum", "Generating random with average", 75)
If max = "" Then Exit Sub
If Not IsNumeric(max) Then
MsgBox "Maximum has to be an integer. Try again.", vbExclamation, "Wrong input"
ElseIf max <= min Then
MsgBox "Maximum has to be greater than minimum. Try again.", vbExclamation, "Wrong input"
ElseIf ((CInt(max) + CInt(min)) Mod 2) = 1 Then
MsgBox "Average of (min + max) has to be even. Try again.", vbExclamation, "Wrong input"
Else
Exit Do
End If
Loop

Do While True
cnt = InputBox("Set the count of numbers to generate", "Generating random with average", 100)
If cnt = "" Then Exit Sub
If Not IsNumeric(cnt) Then
MsgBox "Count has to be an integer. Try again.", vbExclamation, "Wrong input"
ElseIf CInt(cnt) <= 0 Then
MsgBox "Count has to be a positive integer. Try again.", vbExclamation, "Wrong input"
Else
Exit Do
End If
Loop

Call generateRandomWithAverage(CInt(min), CInt(max), CInt(cnt))
End Sub

Sub generateRandomWithAverage(min As Integer, max As Integer, cnt As Integer)
Dim random As Double
Dim i, avg, sum, desiredAvg, diff As Integer

sum = 0
desiredAvg = (min + max) / 2

For i = 1 To cnt
Cells(i, 1) = Excel.Application.WorksheetFunction.RandBetween(mi n, max)
sum = sum + Cells(i, 1)
Next

diff = sum - desiredAvg * cnt

i = 1
Do While diff <> 0
If diff > 0 Then
If Cells(i, 1) = min Then GoTo continue
Cells(i, 1) = Cells(i, 1) - 1
diff = diff - 1
Else
If Cells(i, 1) = max Then GoTo continue
Cells(i, 1) = Cells(i, 1) + 1
diff = diff + 1
End If

continue:
i = i + 1
If i > cnt Then
i = 1
End If
Loop

End Sub

[art1364]

در پاسخ به این سوال این کد را پیدا کردم اما به نتیجه دلخواهم دست پیدا نکردم میشه راهنمایی کنید؟ (تصویر کاری که انجام دادم به پیوست است)
Function RandIntVect(n AsLong, a AsLong, b AsLong, mean AsDouble, tol AsDouble,Optional maxTries AsLong=1000)AsVariant
'Uses a hit-or-miss approach to generate a vector of n random ints in a,b inclusive whose mean is
'within the tolerance tol of the given target mean
'The function raises an error if maxTries misses occur without a hit

Dim sum AsLong, i AsLong, j AsLong
Dim lowTarget AsDouble, highTarget AsDouble'targets for *sums*
Dim vect AsVariant

lowTarget = n *(mean - tol)
highTarget = n *(mean + tol)

For i =1To maxTries
ReDim vect(1To n)
sum =0
j =0
DoWhile j < n And sum + a *(n - j)<= highTarget And sum + b *(n - j)>= lowTarget
j = j +1
vect(j)= Application.WorksheetFunction.RandBetween(a, b)
sum = sum + vect(j)
Loop
If j = n And lowTarget <= sum And sum <= highTarget Then
'Debug.Print i 'uncomment this line to see how many tries required
RandIntVect = vect
ExitFunction
EndIf
Next i
'error if we get to here
RandIntVect = CVErr(xlErrValue)
EndFunction