VBA 输入数据z,根据条件随机(如大于x,小于y的)生产n个数据,使其总和等于z,如何编写VBA代码?
假设输入数据z,如何根据条件(如大于x,小于y的)产生n个的数字,使其总和等于z,然后把它们赋给sheet1的第一列中,怎么在sheet1的宏里面编辑代码?可参考一下代码...
假设输入数据z,如何根据条件(如大于x,小于y的)产生n个的数字,使其总和等于z,然后把它们赋给sheet1的第一列中,怎么在sheet1的宏里面编辑代码?可参考一下代码:
Sub aa()
Dim i As Long, sum As Long, a(10) As Long
Do
Randomize '可使每次产生的随机数不同
sum = 0
For i = 1 To 10 '产生10个随机数
a(i) = (Rnd * (10-1+1)) + 1 '产生[1,10]的随机数
sum = sum + a(i)
Next
If sum = 50 Then '令其和等于50
Exit Do
End If
Loop
For i = 1 To 10
Cells(i, 1) = a(i) '赋值给单元格
Next
End Sub 展开
Sub aa()
Dim i As Long, sum As Long, a(10) As Long
Do
Randomize '可使每次产生的随机数不同
sum = 0
For i = 1 To 10 '产生10个随机数
a(i) = (Rnd * (10-1+1)) + 1 '产生[1,10]的随机数
sum = sum + a(i)
Next
If sum = 50 Then '令其和等于50
Exit Do
End If
Loop
For i = 1 To 10
Cells(i, 1) = a(i) '赋值给单元格
Next
End Sub 展开
2个回答
展开全部
给你两段代码 我更倾向于用第一段代码.因为可能会少循环几次就可以得到结果
Sub aa()
Dim Z, He, M, N, X, Y As Long
Dim YsArr() As Double
N = 10 '要生成的数字个数
X = 3 '生成数的最小值
Y = 20 '生成数的最大值
Z = 100 '生成数的和
Do
For i = 1 To N - 1
ReDim Preserve YsArr(1 To i)
YsArr(i) = Int(Rnd * (Y - X)) + X
Next
He = WorksheetFunction.Sum(YsArr)
If Z - He >= X And Z - He <= Y Then
M = UBound(YsArr) + 1
ReDim Preserve YsArr(1 To M)
YsArr(M) = Z - He
Else
Erase YsArr
End If
Loop Until M = N
Range("A1").Resize(M, 1) = WorksheetFunction.Transpose(YsArr)
End Sub
Sub bb()
Dim Z, He, M, N, X, Y As Long
Dim YsArr() As Double
N = 10 '要生成的数字个数
X = 3 '生成数的最小值
Y = 20 '生成数的最大值
Z = 100 '生成数的和
If Z = "False" Then Exit Sub
Do
For i = 1 To N
ReDim Preserve YsArr(1 To i)
YsArr(i) = Int(Rnd * (Y - X)) + X
Next
Loop Until WorksheetFunction.Sum(YsArr) = Z
Range("A1").Resize(N, 1) = WorksheetFunction.Transpose(YsArr)
End Sub
更多追问追答
追问
您好,我的需求是:这个N是算出来的,是由总金额(也就是Z)/(x或y的中间数然后取整),而且Z也是随机的变动的数字,比如200000,2540000等等,这个怎么处理呢?
追答
我帮你改了一下加入了Z,X,Y 的输入窗口.你试试
Sub aa()
Dim Z, He, M, N, X, Y As Variant
Dim YsArr() As Double
With Application
Z = .InputBox("输入合计金额:", "合计金额输入窗口", Type:=1)
X = .InputBox("输入最小值:", "最小值输入窗口", Type:=1)
Y = .InputBox("输入最大值:", "最大值输入窗口", Type:=1)
End With
If Z = "False" Or X = "False" Or Y = "False" Then Exit Sub
N = Int(Z / ((Y + X) / 2))
Do
For i = 1 To N - 1
ReDim Preserve YsArr(1 To i)
YsArr(i) = Int(Rnd * (Y - X)) + X
Next
He = WorksheetFunction.Sum(YsArr)
If Z - He >= X And Z - He <= Y Then
M = UBound(YsArr) + 1
ReDim Preserve YsArr(1 To M)
YsArr(M) = Z - He
Else
Erase YsArr
End If
Loop Until M = N
Range("A1").Resize(M, 1) = WorksheetFunction.Transpose(YsArr)
End Sub
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询