填充随机数数组以在excel vba中求和[关闭]

Question

我正在尝试为其创建一个采样工具

我需要在 0 到 3000 之间以 500 的倍数随机生成数字，这样它们的总和就是一个固定数字，比如 12 个插槽中的 10000

除此之外，我需要运行大约 100000 到 1000000 的多次迭代（尚未决定。

我的方法是创建一个二维数组，设置一个约束来验证一次迭代的总和，并且只有当条件为真时才将其输入到最终的数据样本中。

我在以下代码中犯了一些非常可怕的错误，无法弄清楚在哪里......感谢帮助

Public Sub Generatenums()
    Dim GRP() As Long, Random() As Long
    Dim RandomTotal As Long, t As Long, w As Long, i As Long, j As Long

    ReDim GRP(1 To 100, 1 To 12)
    ReDim Random(1 To 12)

    For i = 1 To 100
        For j = 1 To 12
            Random(j) = Int(Rnd() * 7) * 500
            RandomTotal = RandomTotal + Random(j)
        Next j

        If RandomTotal = 10000 Then
            For k = 1 To 12
                GRP(i, k) = Random(k)
            Next k
        End If
    Next i

    Range("A1").Select
    For t = 1 To 100
        For w = 1 To 12
            Cells(t, w).Value = GRP(t, w)
        Next w
    Next t
End Sub

Answer 1

Fantom，欢迎来到 SO。

评论者是对的：这将需要很长时间才能运行。

不要将其视为要填充为某个总和的数组，而应将其视为弹球盘或Galton Board，其中有 20 个球在周围弹跳并最终进入底部的垃圾箱。为什么是20？因为您想要以 500 为增量的 10000 的总和，并将 10000/500 = 20 视为一个球。

现在程序可以在线性时间内运行。您不会随机化总和，而是随机化球将落入 12 个插槽中的哪个插槽。然后将每个插槽中的球数乘以 500，总和将始终为 10000。

其中一个循环如下所示：

For i = 1 To 20
  x = Rnd() * 12 + 1
  If x > 12 Then x = 12
  If x < 1 Then x = 1
  bin(x) = bin(x) + 1
Next i

这足以解决您的问题，还是您需要更多？