关于在一串数据中求一个汇总数的求助

kinoshen

[求助] 关于在一串数据中求一个汇总数的求助 [复制链接]

我们和某一个客户会产生好多应收款，该客户汇过来的钱是从这些应收款中取值出来的，每次和对方财务对账他们都很不耐烦，所以想要求一个在一批数据中查找出部分汇总数符合条件的可能。 详见附件。 谢谢。

到账核算.rar (10.93 KB, 下载次数: 24)

2014-12-15 12:37 上传

点击文件名下载附件

zhaogang1960

请参考：

1. Dim arr, brr(), m, n, tt#, dzje#
   
2. 
   
3. Sub Macro1()
   
4.     m = [a1].CurrentRegion.Rows.Count - 1
   
5.     arr = [b2].Resize(m)
   
6.     dzje = [b24]
   
7.     For n = 1 To m
   
8.         Call zhdg("", 0, 0)
   
9.     Next
   
10.     MsgBox "没有结果"
    
11. End Sub
    
12. 
    
13. Sub zhdg(s$, i, t%)
    
14.     If t = n Then
    
15.         p = Split(s, ";")
    
16.         tt = 0
    
17.         For j = 1 To n
    
18.             tt = tt + arr(p(j), 1)
    
19.         Next
    
20.         If tt = dzje Then
    
21.             ReDim brr(1 To n, 1 To 1)
    
22.             For j = 1 To n
    
23.                 brr(j, 1) = arr(p(j), 1)
    
24.             Next
    
25.             [i:i] = ""
    
26.             [i1].Resize(n) = brr
    
27.             MsgBox "共有" & n & "个数据，写到I列。"
    
28.             End
    
29.         End If
    
30.         Exit Sub
    
31.     End If
    
32.     For j = i + 1 To m
    
33.         Call zhdg(s & ";" & j, j, t + 1)
    
34.     Next j
    
35. End Sub
    

复制代码

zhaogang1960

你给出的6221.5程序没有查出来，请看附件中重新给出的数据：
到账核算.rar (19.01 KB, 下载次数: 50)

2014-12-15 18:06 上传

点击文件名下载附件

张雄友

太强大了，赵版也精通递归了。有个小问题，如果到账金额，有多种情况怎么办？

zhaogang1960

张雄友 发表于 2014-12-15 18:29
太强大了，赵版也精通递归了。有个小问题，如果到账金额，有多种情况怎么办？

1. Dim arr, brr(), m, n, tt#, dzje#, c%
   
2. 
   
3. Sub Macro1()
   
4.     m = [a1].CurrentRegion.Rows.Count - 1
   
5.     arr = [b2].Resize(m)
   
6.     dzje = [b24]
   
7.     For n = 1 To m
   
8.         Call zhdg("", 0, 0)
   
9.     Next
   
10.     If c = 0 Then
    
11.         MsgBox "没有结果"
    
12.     Else
    
13.         MsgBox "ok，共有" & c & "组数据。"
    
14.     End If
    
15.     Erase arr, brr
    
16.     c = 0
    
17. End Sub
    
18. 
    
19. Sub zhdg(s$, i, t%)
    
20.     If t = n Then
    
21.         p = Split(s, ";")
    
22.         tt = 0
    
23.         For j = 1 To n
    
24.             tt = tt + arr(p(j), 1)
    
25.         Next
    
26.         If tt = dzje Then
    
27.             ReDim brr(1 To n, 1 To 1)
    
28.             For j = 1 To n
    
29.                 brr(j, 1) = arr(p(j), 1)
    
30.             Next
    
31.             c = c + 1
    
32.             If c = 1 Then [i1].CurrentRegion.ClearContents
    
33.             Cells(1, c + 8).Resize(n) = brr
    
34.             If MsgBox("第" & c & "共有" & n & "个数据，是否继续查找？", vbYesNo) = vbNo Then End
    
35.         End If
    
36.         Exit Sub
    
37.     End If
    
38.     For j = i + 1 To m
    
39.         Call zhdg(s & ";" & j, j, t + 1)
    
40.     Next j
    
41. End Sub
    

复制代码

zhaogang1960

请看效果
到账核算2.rar (20.11 KB, 下载次数: 52)

2014-12-15 18:54 上传

点击文件名下载附件

zhaogang1960

张雄友  您有没有发现，执行后一直在处理当中，死机了。  发表于 2014-12-15 19:17 IP:116.18.55.8 删除

那不是死机，是从1到最大行号之间所有组合进行计算，这种倒过来的问题只能每个组合都计算一遍

很像高等数学中不定积分与导数的关系，导数好求，倒过来求不定积分就难了

张雄友

zhaogang1960 发表于 2014-12-15 19:52
那不是死机，是从1到最大行号之间所有组合进行计算，这种倒过来的问题只能每个组合都计算一遍很像高等数学 ...

啊。想通了一点，就是不多思考，香川的很多例子就是这个意思的。（如：根据总金额凑数）

zhaogang1960

张雄友 发表于 2014-12-15 19:55
啊。想通了一点，就是不多思考，香川的很多例子就是这个意思的。（如：根据总金额凑数）

香川对这方面有研究，估计她能写出高效的代码
我一不爱看书，二不爱看别人写的代码，更不会算法，喜欢用不用看书就能会的少量知识，解决尽量多的问题

香川群子

楼主数据量少，循环遍历进行组合匹配还能试一试。

但还是应该直接推荐用我的下面链接的这个程序：
http://club.excelhome.net/thread-1085112-1-1.html