求助，想随机生成的 数的和等于某个数

闻启学

求助，想随机生成的 数的和等于某个数

随机数 个数不限 具体看图片

自己写了一个
但是 是死循环的
求救

1. Sub eee()
   
2.     Dim mytt As Double
   
3.     Dim mycc As Double
   
4.     Dim myaa As Double
   
5.     Dim mybb As Double
   
6.     Dim mydd As Double
   
7.     Dim myee As Double
   
8.     mytt = 133.32 * 1000
   
9.     myaa = 10 * 1000
   
10.     mybb = 1000 * 15.5
    
11.     Dim arr()
    
12. 100:
    
13. k = 0
    
14.     Do While myee <= mytt '//当汇总数 小于总数 则循环
    
15.    
    
16.         mycc = WorksheetFunction.RandBetween(10000, 15500) '//随机生成数据
    
17.            myee = myee + mycc
    
18.         If mytt - myee < mycc Then  '/ /如果 总数 减减去 汇总数 小于随机数
    
19.             mycc = mytt - myee '//随机数等于 总数 -汇总数
    
20.             If mycc < 10000 Or mycc > 15500 Then  '//如果随机数小于 10000 和15500 范围 重新循环
    
21.             myee = 0 '//汇总数归 0
    
22.             GoTo 100
    
23.             
    
24.             End If
    
25.             
    
26.         End If
    
27.         '
    
28.         k = k + 1
    
29.         ReDim Preserve arr(1 To 3, 1 To k)
    
30.         arr(3, k) = Round(mycc, 0)
    
31.         arr(2, k) = Round((8000 - 6000) * Rnd + 6000, 0)
    
32.         arr(1, k) = Round(arr(2, k) + arr(3, k), 0)
    
33.       
    
34.         Debug.Print mycc, myee
    
35.     Loop
    
36.     arr = WorksheetFunction.Transpose(arr)
    
37.     ThisWorkbook.Sheets("Sheet2").Range("A1").Resize(UBound(arr), UBound(arr, 2)) = arr
    
38.     Stop
    
39. End Sub

复制代码

micch

1. '// 输出在M2以下
   
2. Sub Main()
   
3.     Range("m2").Resize(10).Value = GetRndNum(133320, 10000, 15500, 10)
   
4. End Sub
   
5. Function GetRndNum(H, h1, h2, n)
   
6.     v% = H / n
   
7.     ReDim ar(1 To n, 0)
   
8.     For i = 1 To n - 1: ar(i, 0) = v: Next
   
9.     ar(n, 0) = H - v * (n - 1)
   
10.     Randomize
    
11.     For i = 1 To n * 30
    
12.         r1 = Int(Rnd * n) + 1
    
13.         r2 = (Int(Rnd * (n - 1) + r1 + 1) - 1) Mod n + 1
    
14.         If h1 + h2 < ar(r1, 0) + ar(r2, 0) Then j = h2 - ar(r2, 0) Else j = ar(r1, 0) - h1
    
15.         k = Int(Rnd * j): ar(r1, 0) = ar(r1, 0) - k: ar(r2, 0) = ar(r2, 0) + k
    
16.     Next
    
17.     GetRndNum = ar
    
18. End Function

复制代码

wimm

Sub 生成随机数并求和()     Dim ws As Worksheet     Set ws = ThisWorkbook.Sheets("Sheet1") ' 将 "Sheet1" 替换为你实际的工作表名称          Dim totalCells As Integer     totalCells = 10 ' 生成随机数的单元格数量          Dim minRange As Double     minRange = 10 ' 范围的最小值          Dim maxRange As Double     maxRange = 15.5 ' 范围的最大值          Dim desiredSum As Double     desiredSum = 133.32 ' 随机数之和的目标值          Dim currentSum As Double     currentSum = 0          Dim i As Integer          ' 清除之前的数据（可选）     ws.Range("A1:A" & totalCells).ClearContents          ' 生成随机数并计算和     For i = 1 To totalCells         Dim randomValue As Double         randomValue = minRange + Rnd() * (maxRange - minRange)                  currentSum = currentSum + randomValue                  ' 将随机数写入单元格         ws.Cells(i, 1).Value = randomValue     Next i          ' 调整最后一个单元格的值，使总和等于目标值     ws.Cells(totalCells, 1).Value = ws.Cells(totalCells, 1).Value + (desiredSum - currentSum) End Sub

闻启学

micch 发表于 2023-7-25 16:05

多谢   代码有个弊病 就是 指定生成个数

随机生成个数 是未知数的