首先，思考算24的实质，就是任取4个数(一般为1-10)【例如取4个数：a1、a2、a3、a4】
通过每次2个数值的加、减、乘、除4种算法中的一个，得到一个【2元素计算结果】
【例如 a1 和 a2 用加法：计算结果=a1+a2】
接着将这个【2元素计算结果】继续以加、减、乘、除4种算法中的一个，
和剩余的2个数中的一个，或者剩余两个数的另一次计算结果，继续计算，得到【3元素计算结果】
【例如对于计算结果(a1+a2)用乘法：（a1+a2）a3，或（a1+a2）a4】
或者，也包含直接以a3、a4也同样计算一次，如用减法得到结果【(a3-a4)】
最后，将这个【3元素计算结果】继续以加、减、乘、除4种算法中的一个，
和剩余的最后一个数，继续计算，就最后得到4元素计算结果了
【例如：（a1+a2）a3-a4，或（a1+a2）a3/a4等】
或者，也包含第一次计算结果（a1+a2）和第二次计算结果（a3-a4）的计算结果【如(a1+a2)*(a3-a4)】
这样，一般说来，4个元素通过3次计算过程，就可以得到一个最终的，【仅使用加、减、乘、除4种算法的】计算结果。
即：
如果这个最终计算结果正好=24，计算找到了一个解。
实际人脑计算时，大多凭借经验，
无法做遍历计算的。
因为，4个数的排列顺序，就有432*1=24种，再加上加、减、乘、除的排列，就更多了。
剔除等效计算结果，实际会有2250种不同的计算方法。
（如果4个数中有重复，则计算结果会减少，但即使4个数全部相同，也最少有100多种计算方式，约40种不同的计算结果。）
因此，使用VBA来计算，成为保证搜寻到所有符合条件解的必然。
接下来，用递归的思路：
递归的要求：
- 每次计算以后，复杂度要降低。
- 计算过程是可以重复的。即，代入参数不同，但参数类型和计算方法，以及判断标准一致。
用术语来说，就是，具有相同的入口、出口和处理条件。
我是采用正向处理过程来处理的。
但是，思考递归时的思路，则是逆向的。
下面进入正题：
首先，思考计算最终结果的出口，那就是，计算结果=24.
入口呢？
前面已经分析过了，应该是第三步计算过程，即两个计算结果参数，
而处理过程，也很简单，就是【加、减、乘、除】
因此，写出代码如下：
Sub calc2(c(), t1, t2)
……
End Sub
递归子过程命名为【calc2】，即最后两个元素的计算。参数1为数组c()含两个计算对象元素就够了。
……
后来发现，需要输出中间计算结果的文字列，所以后来又增加了t1,t2两个入口参数。
（实际可以用数组储存的方式解决，但考虑到代码可读性，后来就没有改。）
下面，举例为加法的处理过程。
s = c(1) + c(2) '计算c(1)和c(2)最后两个元素的加法结果，
If Round(s, 12) = t Then '如果计算结果=t（即计算最终目标值，算24时当然就会在代码开始时将t赋值为=24）
k = k + 1 '结果数组序号+1
d(k) = "=" & t1 & "+" & t2 '在结果数组d中写入计算结果
e(k) = " =" & t1 & "+" & t2 '在结果数组e中写入计算结果的文字表达式（其实两者内容几乎一样，只差一个空格）
End If
好了，处理过程就是这么简单。
如果略去输出结果到数组的代码部分，代码可以省略为一行。
即：if 【最终计算结果】=【目标值】 then 【输出结果到数组，结束】
然而，考虑到加、减、乘、除四种运算结果的排列，代码显然就【复杂】了。
（实际上，这里的复杂，仅仅是指写的复杂，或代码行数较多，实际上理解非常简单。）
Public drr(3 To 665536, 1 To 2), m, cnt, b
Sub test2()
n = [a1].End(4).Row
ReDim arr(1 To n, 1 To 2)
For i = 1 To n
arr(i, 1) = Cells(i, 1)
arr(i, 2) = Cells(i, 1)
Next
b = [d1]
[f1] = 0
m = 2
cnt = 0
zhjs arr, n
[e1] = cnt
[d3:e65536] = ""
[d3].Resize(m, 2) = drr
Erase drr
End Sub
Sub zhjs(arr(), n)
ReDim brr(1 To n - 1, 1 To 2)
For i = 1 To n - 1
For j = i + 1 To n
If n > 2 Then
l = 0
For k = 1 To n
If k <> i And k <> j Then
l = l + 1
brr(l, 1) = arr(k, 1)
brr(l, 2) = arr(k, 2)
End If
Next
End If
For f = 1 To 5
If f = 4 And arr(i, 1) = 0 Then
[f1] = [f1] + 1
' MsgBox arr(i, 2)
' [a1].End(4) = [a1].End(4) + 1
' End
ElseIf f = 5 And arr(j, 1) = 0 Then
[f1] = [f1] + 1
' MsgBox arr(j, 2)
' [a1].End(4) = [a1].End(4) + 1
' End
Else
brr(n - 1, 1) = js(arr(i, 1), arr(j, 1), f)
brr(n - 1, 2) = jg(arr(i, 2), arr(j, 2), f)
If n = 2 Then
cnt = cnt + 1
If Round(brr(n - 1, 1), 12) = b Then
m = m + 1
drr(m, 1) = brr(n - 1, 1)
drr(m, 2) = brr(n - 1, 2)
End If
Else
zhjs brr, n - 1
End If
End If
Next
Next
Next
End Sub
Function js(n1, n2, f)
Select Case f
Case 1
js = n1 + n2
Case 2
If n1 > n2 Then js = n1 - n2 Else js = n2 - n1
Case 3
js = n1 * n2
Case 4
If n1 = 0 Then js = "!0" Else js = n2 / n1
Case 5
If n2 = 0 Then js = "!0" Else js = n1 / n2
End Select
End Function
Function jg(n1, n2, f)
Select Case f
Case 1
jg = "(" & n1 & "+" & n2 & ")"
Case 2
jg = "(" & n2 & "-" & n1 & ")"
Case 3
jg = "(" & n1 & "*" & n2 & ")"
Case 4
If n1 = 0 Then jg = "/Zero" Else jg = "(" & n2 & "/" & n1 & ")"
Case 5
If n2 = 0 Then jg = "/Zero" Else jg = "(" & n1 & "/" & n2 & ")"
End Select
End Function
网友评论