知道一个合计数，按条件随机分布在18个格子里

Bolidy

如图示，怎么快速把空白格填满！
例如第一个工日是16天，怎么在前面的18个空白格里随机填上16个1，使其求和等于16？
第二行加班总计是18小时，怎么在18个空格子里填上0到2范围的数字，使其求和等于18？

Chip_Kenny

try this:

1. Sub zz()
   
2. Dim ar, a(), b, jjj, n%, t As Boolean, d As Object, nn%
   
3. Set d = CreateObject("scripting.dictionary")
   
4. ar = Range("e6:w" & [w65536].End(3).Row).Value
   
5. For i = 1 To UBound(ar) Step 3
   
6.     ReDim a(1 To 2, 1 To 18)
   
7.     For j = 1 To UBound(a, 2)
   
8.         a(2, j) = Rnd(): a(1, j) = j
   
9.     Next
   
10.     For j = 1 To UBound(a, 2) - 1
    
11.         b = a(2, j)
    
12.         For jj = j + 1 To UBound(a, 2)
    
13.             If a(2, jj) < b Then t = True: jjj = jj: b = a(2, jj)
    
14.         Next
    
15.         If t Then
    
16.             t = False
    
17.             n = a(1, j): a(1, j) = a(1, jjj): a(1, jjj) = n:
    
18.             a(2, jjj) = a(2, j): a(2, j) = b
    
19.         End If
    
20.     Next
    
21.     For j = 1 To UBound(a, 2)
    
22.         If Not a(1, j) > ar(i, 19) Then ar(i, j) = 1 Else ar(i, j) = ""
    
23.     Next
    
24. 1000
    
25.     d.RemoveAll: n = 0: j = 0: jjj = 0: nn = IIf(Int(ar(i + 1, 19)) < 2, Int(ar(i + 1, 19)), 2)
    
26.     Do
    
27.         If d.count > 16 Then GoTo 1000
    
28.         k = Application.WorksheetFunction.RandBetween(jjj, nn)
    
29.         j = j + 1: n = n + k
    
30.         d(j) = k
    
31.     Loop Until n > Int(ar(i + 1, 19)) - 2
    
32.     jj = j: m = n
    
33. 2000
    
34.     j = jj: n = m
    
35.     Do
    
36.         If d.count > 18 Then GoTo 2000
    
37.         k = Application.WorksheetFunction.RandBetween(jjj, ar(i + 1, 19) - n)
    
38.         j = j + 1: n = n + k
    
39.         d(j) = k
    
40.         If d.count > 18 Then jjj = jjj + 1: GoTo 1000
    
41.     Loop Until n = Int(ar(i + 1, 19))
    
42.     If ar(i + 1, 19) > Int(ar(i + 1, 19)) Then
    
43.         j = Application.WorksheetFunction.RandBetween(0, d.count - 1)
    
44.         k = d.keys
    
45.         d(k(j)) = d(k(j)) + Round((ar(i + 1, 19) - Int(ar(i + 1, 19))), 1)
    
46.     End If
    
47.     For j = 1 To 18
    
48.         ar(i + 1, j) = 0
    
49.     Next
    
50.     For Each k In d.keys
    
51.         ar(i + 1, k) = d(k)
    
52.     Next
    
53. Next
    
54. [e6].Resize(UBound(ar), UBound(a, 2)).ClearContents
    
55. [e6].Resize(UBound(ar), UBound(a, 2)) = ar
    
56. End Sub

复制代码

Bolidy

Chip_Kenny 发表于 2018-9-27 12:16
try this:

感谢大神，编了那么长的代码，我还不会用宏，我自己先试一下

zhang6029

好好啊哈哦好