选票

ddz79101

老师！有1个确定的金额，需要在现有的发票金额中选择大于1张的金额，使其相等，若不能相等，则选择最接近的2张或多张发票金额。请老师看看，谢谢！

ykcbf1100

你这是凑数。

ddz79101

ykcbf1100 发表于 2025-1-7 19:15
你这是凑数。

是的！老师！

z865593849

凑数的去论坛搜

ddz79101

z865593849 发表于 2025-1-7 19:28
凑数的去论坛搜

查了！也许我的理解问题，有点看不懂

ykcbf1100

ddz79101 发表于 2025-1-7 20:26
查了！也许我的理解问题，有点看不懂

你这个不太好弄，我刚才用香川凑数法试了一下都无解。

laoye5403

我把香川凑数学习研究了半天，站在大神的肩膀上整了个，你试试

ddz79101

laoye5403 发表于 2025-1-8 20:39
我把香川凑数学习研究了半天，站在大神的肩膀上整了个，你试试

谢谢老师！运行成功

ddz79101

ykcbf1100 发表于 2025-1-8 10:11
你这个不太好弄，我刚才用香川凑数法试了一下都无解。

谢谢老师！辛苦了！

titi012

参与一下，来一个暴力拆解，全列出来，然后找出最接近的，数据太多就不行了。

1. Option Explicit
   
2. 
   
3. Dim Arr, Nrr()
   
4. Dim Q As Long, L As Long, M As Double
   
5. 
   
6. Sub Main()
   
7.     Dim Brr, i&, xStr As String
   
8.     Brr = Range("b2:b15")
   
9.     M = [c18]
   
10.     L = UBound(Brr)
    
11.     ReDim Arr(1 To L + 1)
    
12.     For i = 1 To L
    
13.         Arr(i) = Brr(i, 1)
    
14.     Next
    
15.    
    
16.     Q = 0
    
17.     For i = 1 To L
    
18.         MergeSub 1, 1, i, "", 0
    
19.     Next i
    
20.    
    
21.     For i = 1 To Q
    
22.         If Nrr(2, i) < M Then M = Nrr(2, i): xStr = Nrr(1, i)
    
23.     Next i
    
24.     Brr = Split(xStr, ",")
    
25.     [c2:c15].Clear
    
26.     For i = 0 To UBound(Brr) - 1
    
27.         Cells(Val(Brr(i)) + 1, "c") = Cells(Val(Brr(i)) + 1, "b")
    
28.     Next i
    
29.    
    
30. End Sub
    
31. 
    
32. Sub MergeSub(ByVal x As Long, ByVal y As Long, ByVal C As Long, ByVal S As String, ByVal N As Double)
    
33.    
    
34.     If x > L + 1 Or N > M Then Exit Sub
    
35.    
    
36.     If y > C Then
    
37.         Q = Q + 1
    
38.         ReDim Preserve Nrr(1 To 2, 1 To Q)
    
39.         Nrr(1, Q) = S
    
40.         Nrr(2, Q) = M - N
    
41.         Exit Sub
    
42.     End If
    
43.    
    
44.     MergeSub x + 1, y + 1, C, S & x & ",", N + Arr(x)
    
45.     MergeSub x + 1, y, C, S, N
    
46.    
    
47. End Sub
    
48. 
    

复制代码