Option Explicit
Sub TEST2()
Dim ar, br, cr, i&, j&, n&, iMin&
ar = Range("B2", Cells(Rows.Count, "B").End(xlUp))
iMin = WorksheetFunction.Min(ar)
n = Application.InputBox("请选择随机折分数,不超过" & iMin, Title:="提示", Default:=7, Type:=1)
If n = 0 Then Exit Sub
Application.ScreenUpdating = False
[A1].CurrentRegion.Offset(, 2).Clear
ReDim br(1 To UBound(ar), 1 To n)
For i = 1 To UBound(ar)
cr = RndNumIsTotalSum(1, CLng(ar(i, 1)), n, CLng(ar(i, 1)))
For j = 1 To UBound(cr)
br(i, j) = cr(j, 1)
Next j
Next i
[C2].Resize(UBound(br), UBound(br, 2)) = br
Application.ScreenUpdating = True
Beep
End Sub |