【求助】拆分随机数，要求上下浮动一个百分比

LLLCCCDDD

如题，需求是 有一个总数在[A2],需要将他随机拆分成[B2]=200个数，这200个数的和=A2，拆分结果显示在F列，主要是前提要求是：拆分后的数值只能在平均值上下浮动例如10%（即   5666/200*0.9 <n<5666/200*1.1）


附件： 随机拆分.zip (5.73 KB, 下载次数: 5)

2018-7-16 15:26 上传

点击文件名下载附件

LLLCCCDDD

help!

一把小刀闯天下

LLLCCCDDD 发表于 2018-7-16 15:49
help!

Option Explicit

Sub test()
  Dim sum, num, ave, i
  num = [b2].Value: ave = [a2].Value / num
  ReDim arr(1 To num, 1 To 1)
  Randomize
  For i = 1 To num
    arr(i, 1) = ave * 0.9 + ave * 0.2 * Rnd
    sum = sum + arr(i, 1)
    If i = num - 1 Then
      If [a2].Value - sum >= 0.9 * ave And [a2].Value - sum <= 1.1 * ave Then
        arr(num, 1) = [a2].Value - sum: Exit For
      Else
        i = 0: sum = 0
      End If
    End If
  Next
  With [f2]
    .Resize(Rows.Count - 1).Clear
    .Resize(num) = arr
  End With
End Sub

zhjlgaojuan

Sub test(SourceNum As Double, SplitCount As Long)
Dim TargetArr(), TmpSum#, AverageNum#
ReDim TargetArr(1 To SplitCount, 1 To 1)
AverageNum = SourceNum / SplitCount
TmpSum = 0
TargetArr(1, 1) = AverageNum * WorksheetFunction.RandBetween(9900, 10100) / 10000
TmpSum = TmpSum + TargetArr(1, 1)
For i = 2 To SplitCount - 1
    If (SourceNum - TmpSum) / (SplitCount - i + 1) > AverageNum Then
        TargetArr(i, 1) = AverageNum * (1 + WorksheetFunction.RandBetween(0, 100) / 10000)
    Else
        TargetArr(i, 1) = AverageNum * (1 - WorksheetFunction.RandBetween(0, 100) / 10000)
    End If
    TmpSum = TmpSum + TargetArr(i, 1)
Next
TargetArr(SplitCount, 1) = SourceNum - TmpSum
[f2].Resize(SplitCount, 1) = TargetArr
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = "$F$1" Then [g1].Select: test [a2], [b2]
End Sub

LLLCCCDDD

一把小刀闯天下 发表于 2018-7-16 15:54
Option Explicit

Sub test()

麻烦问一下，我用你的代码改良了一下，原本只是拆分一行的数据，现在改成循环多行拆分，但是会出现有时拆分后的总和与拆分之前的不一致，可以帮忙看一下吗（点多几次执行后，附件的J列之和有时与A列之和不一致）

拆分重量-20180728.zip (96.11 KB, 下载次数: 6)

2018-7-28 19:17 上传

点击文件名下载附件