Генерация n случайных чисел Суммируется до значения ячейки Vba код

Question

Привет, я пытаюсь сгенерировать n случайных чисел в коде Vba, чтобы их сумма каждый раз была разной:

одна сумма времени должна быть 1000, одна сумма времени должна быть 1500 ... и такна сумму в коде называется (items)

проблема в массиве, я не хотел генерировать случайные числа для фиксированных строк, мне нужно генерировать случайным образом один раз 10 строк для одного столбца .. один раз 15 строк для 1 столбца ... Как это исправить?

Sub randomality()
Dim ary(1 To 10) As Double, zum As Double
Dim i As Long
Randomize
zum = 0
Dim destination_order_unit As String
Dim items As Variant

 Number_required = Range("K2").Value
 destination_order_unit = Range("L5").Value
  Range(destination_order_unit).Select
 items = InputBox("All units ")
 Range("J2").Value = items

  For i = 1 To 10
    ary(i) = Rnd
    zum = zum + ary(i)
Next i

For i = 1 To 10
    ary(i) = ary(i) / zum
Next i

With Application.WorksheetFunction
    For i = 1 To 10
        Cells(i, "D").Value = Application.WorksheetFunction.RoundUp(items * ary(i), 0)
    Next i
    Cells(10, "D").Value = items - .Sum(Range("D1:D9"))
End With
End Sub

Answer 1

Я думаю, что ваш вопрос больше похож на то, как вставить массив, который идет вертикально? Проблема со случайными числами сбивает меня с толку, и мне трудно следить за этим, но именно так вы можете создать набор из 10 случайных чисел, сумма которых равна 20. Вы можете реорганизовать это, если вы просто хотите убедиться,они не одинаковы в конце цикла, говоря <> к.

Sub BuildRandoms()
    Const minNumber As Long = 0
    Const MaxNumber As Long = 5
    Const finalSum As Long = 20


    Dim ary(1 To 10) As Long, i As Long

    Do
        For i = LBound(ary) To UBound(ary)
            ary(i) = Application.WorksheetFunction.RandBetween(minNumber, MaxNumber)
        Next i

    Loop Until Application.WorksheetFunction.Sum(ary) = finalSum

    'resized the range you're trying to paste values
    Range("D10").Resize(UBound(ary), 1).Value = Application.WorksheetFunction.Transpose(ary)

End Sub