生成n个随机数汇总至单元格值Vba代码

时间:2019-11-10 19:20:21

标签: excel vba excel-formula

嗨,我正在尝试在Vba代码中生成n个随机数,以使它们的总和每次都必须不同:

一次总和必须为1000 一次总和必须是1500 ...等等 代码中的总和称为(项)

问题是我不想为固定行生成随机数的数组,我需要为一列随机生成一次10行..一次为1列生成15行... 我该如何解决?

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

1 个答案:

答案 0 :(得分:0)

我认为您的问题更多是关于如何插入垂直排列的数组?随机数的问题使我不知所措,但我一直很努力,但这是您如何创建一组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