Question

Excel 使用vba做实现递归

Sub 测试1()

Dim a As Integer
a = ActiveSheet.UsedRange.Rows.Count '获取行数
Dim lon As Integer
lon = a - 2 '获取数据行数

Dim arr(100) As Double

'将数据某一列存贮到数组中，列中为都是double类型的数据，有正有负
For i = 2 To a Step 1
arr(i - 2) = Worksheets("Sheet1").Range("I" & i).Value()
Next

'要求如下：列中所有数，任意项之和为0，取出这些和为0的项放入sheet2中
'例如： a[0]=1,a[1]=1,a[2]=-1,a[3]=-2
'则取：a[0]=1,a[2]=-1 ； a[1]=1,a[2]=-1 ；a[0]=1,a[1]=1,a[3]=-2
'将三种结果的行数据放入sheet2
'即：数据的第0行，第2行；第1行，第2行；第0行，第1行，第3行；三个符合条件数据分别放入sheet2，且中间空出一行做区分
‘以下为当两个数、三个数时，相加为0的时候筛选出的数据
‘***希望大神能给个递归的方式，在有n个数相加为0 的时候同样能做出筛选***

If (lon > 2) Then
For j = 0 To lon - 1 Step 1
For k = j To lon - 2 Step 1
If (arr(j) + arr(k) = 0) Then '判断两个数的和为0
ActiveWorkbook.Sheets("Sheet1").Select '激活表1
Union(Rows(j + 2), Rows(k + 2)).Select '选中行
Selection.Copy '复制行
ActiveWorkbook.Sheets("Sheet2").Select '转到表2 并激活
maxLine = ActiveSheet.UsedRange.Rows.Count '选中最后一行下一行第一个表格
Cells(maxLine + 2, 1).Select '找到最后一行
ActiveSheet.Paste '粘贴
ActiveWorkbook.Sheets("Sheet1").Select '返回表1
End If
Next
Next
End If

If (lon > 3) Then
For j = 0 To lon - 1 Step 1
For k = j To lon - 2 Step 1
For l = k To lon - 3 Step 1
If (arr(j) + arr(k) + arr(l) = 0) Then
ActiveWorkbook.Sheets("Sheet1").Select '激活表1
Union(Rows(j + 2), Rows(k + 2), Rows(l + 2)).Select '选中行
Selection.Copy '复制行
ActiveWorkbook.Sheets("Sheet2").Select '转到表2 并激活
maxLine = ActiveSheet.UsedRange.Rows.Count '选中最后一行下一行第一个表格
Cells(maxLine + 2, 1).Select '找到最后一行
ActiveSheet.Paste '粘贴
ActiveWorkbook.Sheets("Sheet1").Select '返回表1
End If
Next
Next
Next
End If
End Sub

Answer 1

可以采取这种思路 1。表的名字用数字（日期，比如1号用 1 ），文档用月，这样是为了方便引用 2。每个表的第一行用于引用上一张表的汇总数据，第二行保留该表的汇总数据 3。
  先建立从1-31张空白表，保存，复制成1-12个月12个文档，修改月初的表的引用和月末的引用 4。  备份这12个文档（可能的话用于下一年） 优点：容易实现，简单不复杂，不需要太多的技巧 缺点：繁琐，每天1张表，还有许多引用，可能到年末的时候运行会很慢，（可以通过把引用上月的数据转成数字而不是公式）

Answer 2

你其实是要求一列中合计为0的项的组合是么？
那么，就有必要生成所有的组合，并判断是否符合要求。
问题是，你还不限制组合的项数……
找到一种算法更重要。
建议用循环而不是递归。递归太占内存。

追问

正式因为项数不定，所以用循环不能写出全部的不重复组合。最高项数是数据总条数，这个是确定的，所以递归存在退出条件，至于占内存的事先不考虑

追答

那你总项数最大可能是多少呢？

用递归方法编了个示例，且算了个10个数据项的示例。

30个自然数据的就难算了，因了计算量增加太多，太多了啊！！！

哎？！怎么不能上传附件了？？？？

下面是运算结果：（数字为行号）

10    

6,7,10    

6,7    

5,6,8,9,10    

5,6,8,9    

4,5,8,10    

4,5,8    

4,5,6,7,8,10    

4,5,6,7,8    

3,7,8,10    

3,7,8    

3,6,9,10    

3,6,9    

3,5,7,10    

3,5,7    

3,4,10    

3,4    

3,4,6,7,10    

3,4,6,7    

3,4,5,6,8,9,10    

3,4,5,6,8,9    

2,8,10    

2,8    

2,6,7,8,10    

2,6,7,8    

2,5,10    

2,5    

2,5,6,7,10    

2,5,6,7    

2,4,6,10    

2,4,6    

2,3,6,8,9,10    

2,3,6,8,9    

2,3,5,7,8,10    

2,3,5,7,8    

2,3,5,6,9,10    

2,3,5,6,9    

2,3,4,8,10    

2,3,4,8    

2,3,4,6,7,8,10    

2,3,4,6,7,8    

2,3,4,5,10    

2,3,4,5    

2,3,4,5,6,7,10    

2,3,4,5,6,7    

1,8,10    

1,8    

1,6,7,8,10    

1,6,7,8    

1,5,10    

1,5    

1,5,6,7,10    

1,5,6,7    

1,4,6,10    

1,4,6    

1,3,6,8,9,10    

1,3,6,8,9    

1,3,5,7,8,10    

1,3,5,7,8    

1,3,5,6,9,10    

1,3,5,6,9    

1,3,4,8,10    

1,3,4,8    

1,3,4,6,7,8,10    

1,3,4,6,7,8    

1,3,4,5,10    

1,3,4,5    

1,3,4,5,6,7,10    

1,3,4,5,6,7    

1,2,5,8,10    

1,2,5,8    

1,2,5,6,7,8,10    

1,2,5,6,7,8    

1,2,4,6,8,10    

1,2,4,6,8    

1,2,4,5,6,10    

1,2,4,5,6    

1,2,3,10    

1,2,3    

1,2,3,6,7,10    

1,2,3,6,7    

1,2,3,5,6,8,9,10    

1,2,3,5,6,8,9    

1,2,3,4,5,8,10    

1,2,3,4,5,8    

1,2,3,4,5,6,7,8,10    

1,2,3,4,5,6,7,8    

Answer 3

千万不要递归，递归会死机的，除非只有几个数。
你需要的算法应该是回溯，我先想一想如何用VBA实现。

追问

好的，先谢啦