Generate “n” random numbers between a and b to reach desired average in m rows

问题

Suppose in column Z with 200 rows, are my optimal averages.

Now I want a macro that generates n random integers between a and b inclusive (n <= 20) so that difference between the average of numbers generated with optimal average is in (-0.15,+0.15).

Example:

Z1:optimal average1=5.5
Z2:optimal average2=5.3

Z200:optimal average200=6.3
n=8
a=1; b=10
numbers of generated:
A1:H1)5-9-4-3-7-4-9-3
A2:H2)10-7-3-2-5-4-3-9
.
.
.
A200:H200)4-8-9-6-6-6-10-2

回答1:

Here is a hit-or-miss approach (which is often the only viable way to get random numbers which satisfy additional constraints in an unbiased way):

Function RandIntVect(n As Long, a As Long, b As Long, mean As Double, tol As Double, Optional maxTries As Long = 1000) As Variant
    '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 As Long, i As Long, j As Long
    Dim lowTarget As Double, highTarget As Double 'targets for *sums*
    Dim vect As Variant

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

    For i = 1 To maxTries
        ReDim vect(1 To n)
        sum = 0
        j = 0
        Do While 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
            Exit Function
        End If
    Next i
    'error if we get to here
    RandIntVect = CVErr(xlErrValue)
End Function

This could be used as a worksheet array formula. The target means were in column I and in A2:H2 I entered =RandIntVect(8,1,10,I2,0.15) (with ctrl+shift+enter as an array formula) and then copied down:

Note that array formulas are volatile, so these numbers would be recalculated every time the worksheet is. You could use the function in VBA to place the numbers directly in the ranges rather than using the function as a worksheet formula. Something like:

Sub test()
    Dim i As Long
    For i = 1 To 3
        Range(Cells(i + 1, 1), Cells(i + 1, 8)).Value = RandIntVect(8, 1, 10, Cells(i + 1, 9).Value, 0.15)
    Next i
End Sub

回答2:

enter image description here

The difference between two means is not within range (0.15+, 0.15-)

来源：https://stackoverflow.com/questions/52024926/generate-n-random-numbers-between-a-and-b-to-reach-desired-average-in-m-rows

标签

vba

excel-vba

random

average