随机拆分数据为多行，总数保持不表

YXSWZ

Sub test() 'VX:Lsy04110188
       Sheets("本月销售明细").Select: r = 1
       arr = [a1].CurrentRegion:  brr = [a1].Resize(UBound(arr) * 199, UBound(arr, 2))
      For j = 2 To UBound(arr)
            If Val(arr(j, 6)) <= 85 Then
               r = r + 1
               For i = 1 To UBound(arr, 2)
               brr(r, i) = arr(j, i)
               Next i
           Else
               If Val(arr(j, 6)) <= 85 Then
                   y = 1
               Else
                   y = WorksheetFunction.RandBetween(Application.WorksheetFunction.RoundUp(arr(j, 6) / 85, 0), Application.WorksheetFunction.RoundUp(arr(j, 6) / 85, 0) + 2)
               End If
               ReDim crr(1 To y)
               sm = Val(arr(j, 6)): Call get_rnd_crr(crr, sm)
               For i = 1 To y
               r = r + 1
               For m = 1 To UBound(arr, 2)
               brr(r, m) = arr(j, m)
               Next m
               brr(r, 6) = crr(i):   brr(r, 8) = crr(i) * arr(j, 7)
               Next i
          End If
          Next j
          Sheets("送货单拆分").UsedRange.ClearContents
          Sheets("送货单拆分").[a1].Resize(r, UBound(brr, 2)) = brr

End Sub
Sub get_rnd_crr(crr, sm) 'VX:Lsy04110188
199
k = sm
For j = 1 To UBound(crr) - 1
x = WorksheetFunction.RandBetween(k / (k / 85) - 6, 85)
crr(j) = x
k = k - x
If k <= UBound(crr) - j Then
GoTo 199
End If
Next j
crr(UBound(crr)) = k
End Sub