切割与凑数问题

cagia

附件中的文件为示例文件，要求根据A列的板数，拆分成11~18范围内的多组数的结合，附件中有拆分示例，实际应用中板数的数值范围为30~999以内的任意整数，要求拆分次数最少，次数相同则差值最小（如15，15，14，差值为1，16，14，14则差值为2）求代码

高个子

1. =LET(x,MIN(ROUNDUP(A2/ROW($11:$18),0)),y,INT(A2/x),MID(REPT("+"&y+1,MOD(A2,x))&REPT("+"&y,x-MOD(A2,x)),2,999))

复制代码

imleading

高个子

1. Sub kdy()
   
2.     arr = Range("a2:a" & Cells(Rows.Count, 1).End(xlUp).Row)
   
3.     Dim brr(1 To 999, 1 To 1)
   
4.     For l = 1 To UBound(arr)
   
5.         x = Application.WorksheetFunction.RoundUp(arr(l, 1) / 11, 0)
   
6.         For i = 12 To 18
   
7.             If x > Application.WorksheetFunction.RoundUp(arr(l, 1) / i, 0) Then
   
8.                 x = Application.WorksheetFunction.RoundUp(arr(l, 1) / i, 0)
   
9.             End If
   
10.         Next
    
11.         y = Int(arr(l, 1) / x)
    
12.         Z = arr(l, 1) Mod y
    
13.         For j = 1 To Z
    
14.             w = "+" & y + 1 & w
    
15.         Next
    
16.         For k = 1 To x - Z
    
17.             v = "+" & y & v
    
18.         Next
    
19.         p = w & v
    
20.         brr(l, 1) = Mid(p, 2, 999)
    
21.     Next
    
22.     Range("b2").Resize(UBound(arr)) = brr
    
23. End Sub
    

复制代码

高个子

1. Sub kdy()
   
2.     arr = Range("a2:a" & Cells(Rows.Count, 1).End(xlUp).Row)
   
3.     Dim brr(1 To 999, 1 To 1)
   
4.     For l = 1 To UBound(arr)
   
5.         x = Application.WorksheetFunction.RoundUp(arr(l, 1) / 11, 0)
   
6.         For i = 12 To 18
   
7.             If x > Application.WorksheetFunction.RoundUp(arr(l, 1) / i, 0) Then
   
8.                 x = Application.WorksheetFunction.RoundUp(arr(l, 1) / i, 0)
   
9.             End If
   
10.         Next
    
11.         y = Int(arr(l, 1) / x)
    
12.         Z = arr(l, 1) Mod y
    
13.         For j = 1 To Z
    
14.             w = "+" & y + 1 & w
    
15.         Next
    
16.         For k = 1 To x - Z
    
17.             v = "+" & y & v
    
18.         Next
    
19.         p = w & v
    
20.         brr(l, 1) = Mid(p, 2, 999)
    
21.         w = ""
    
22.         v = ""
    
23.     Next
    
24.     Range("b2").Resize(UBound(arr)) = brr
    
25. End Sub

复制代码

这个没问题了

剑指E

Sub ss()
    Dim ar, br(), a%, b&, c&, d%, n%
    ar = Range("a1").CurrentRegion
    For i = 2 To UBound(ar)
        a = Application.RoundUp(ar(i, 1) / 18, 0)
        b = Application.RoundUp(ar(i, 1) / a, 0)
        c = a * b - ar(i, 1)
        ReDim br(1 To a)
        For j = 1 To a
            br(j) = b
        Next
        Do While n < c
            d = n Mod a + 1
            br(d) = br(d) - 1
            n = n + 1
        Loop
        n = 0
        ar(i, 2) = Join(br, "+")
    Next
    Range("a1").Resize(UBound(ar), 2) = ar
End Sub

剑指E

笨鸟飞不高

折分问题求解.zip (15.81 KB, 下载次数: 12)

2022-12-21 13:45 上传

点击文件名下载附件

ykcbf1100

笨鸟飞不高 发表于 2022-12-21 13:45

Ceiling函数建议更新为Ceiling_Precise函数。

blackttea1

学习啦，谢谢