计算24点的VBA程序

陈宫在家吗

想在网上找个“计算24点”的VBA程序，未果，于是自己编了一个。
参考了 CSDN 网站上一个C++计算24点的程序 https://blog.csdn.net/gxgdcyy/article/details/136046031


我的VBA只是一知半解的水平，把代码发出来也是抛砖引玉，欢迎大家指正。


首先编了一个“四则计算”的函数，包括  a+b、a-b、a*b、a/b、b-a、b/a 6种情况

1. Public Function 四则计算(ByVal x As Double, ByVal y As Double, ByVal z As Integer) As Double
   
2.     If x = 0 And y = 0 Then
   
3.         四则计算 = Switch(z = 1, x + y)
   
4.     ElseIf x = 0 Then
   
5.         四则计算 = Switch(z = 1, x + y, z = 2, x - y, z = 3, x * y)
   
6.     ElseIf y = 0 Then
   
7.         四则计算 = Switch(z = 1, x + y, z = 3, x * y, z = 5, y - x)
   
8.     Else
   
9.         四则计算 = Switch(z = 1, x + y, z = 2, x - y, z = 3, x * y, z = 4, x / y, z = 5, y - x, z = 6, y / x)
   
10.     End If
    
11. End Function

复制代码

陈宫在家吗

然后把其他功能全部写在主程序里面了。（系统提示文字太长了，只能分成两段了）

Part 1：

1. Sub 计算24点()
   
2. 
   
3.     On Error Resume Next
   
4. 
   
5.     Sheets(1).[c4].Clear
   
6. 
   
7.     ' 先将4个数字排序、写入数组arr1
   
8.     Dim dic_temp, arr(4), arr1(), str_temp As String
   
9.    
   
10.     Set dic_temp = CreateObject("scripting.dictionary") ' 创建一个字典，用来消除重复的排序
    
11.    
    
12.     arr(1) = Int(Sheets(1).[b4].Value)
    
13.     arr(2) = Int(Sheets(1).[b5].Value)
    
14.     arr(3) = Int(Sheets(1).[b6].Value)
    
15.     arr(4) = Int(Sheets(1).[b7].Value)
    
16.    
    
17.     For i = 1 To 4
    
18.         For j = 1 To 4
    
19.             If i <> j Then
    
20.                 For k = 1 To 4
    
21.                     If k <> i And k <> j Then
    
22.                         For l = 1 To 4
    
23.                             If l <> i And l <> j And l <> k Then
    
24.                            
    
25.                                 ' 检查排序是否已经存在
    
26.                                 str_temp = arr(i) & "," & arr(j) & "," & arr(k) & "," & arr(l)
    
27.                                 
    
28.                                 ' 如果不存在，则写入字典、数组
    
29.                                 If Not dic_temp.exists(str_temp) Then
    
30.                                     dic_temp(str_temp) = str_temp
    
31.                                     r = r + 1
    
32.                                     ReDim Preserve arr1(1 To 4, 1 To r)
    
33.                                     
    
34.                                     arr1(1, r) = arr(i)
    
35.                                     arr1(2, r) = arr(j)
    
36.                                     arr1(3, r) = arr(k)
    
37.                                     arr1(4, r) = arr(l)
    
38.                                 End If
    
39.                                 
    
40.                             End If
    
41.                         Next
    
42.                     End If
    
43.                 Next
    
44.             End If
    
45.         Next
    
46.     Next
    
47. 
    
48.     ' 组合排序完成，为4行、r列
    
49. 
    
50.     Dim a1 As Integer, a2 As Integer, a3 As Integer, a4 As Integer  ' 临时存储排序后的数据
    
51.     Dim num1 As Double, num2 As Double, num3 As Double  ' 3次计算出来的结果
    
52.     Dim ss1 As String, ss2 As String, ss3 As String  ' 用于存储计算中间过程
    
53.    
    
54.     ' 第一种情况：((a+b)+c)+d
    
55.     For loop1 = 1 To UBound(arr1, 2)
    
56.         For s1 = 1 To 6 ' 分别代表第一个 + - * /
    
57.             num1 = 四则计算(arr1(1, loop1), arr1(2, loop1), s1)
    
58.             
    
59.             If Err <> 0 Then
    
60.                 Err.Clear
    
61.                 GoTo 100
    
62.             End If
    
63.             
    
64.             If num1 < 0 Then GoTo 100
    
65.             
    
66.             For s2 = 1 To 6
    
67.                 num2 = 四则计算(num1, arr1(3, loop1), s2)
    
68.                
    
69.                 If Err <> 0 Then
    
70.                     Err.Clear
    
71.                     GoTo 200
    
72.                 End If
    
73.                
    
74.                 If num2 < 0 Then GoTo 200
    
75.                
    
76.                 For s3 = 1 To 6
    
77.                     num3 = 四则计算(num2, arr1(4, loop1), s3)
    
78.                     
    
79.                     If Err <> 0 Then
    
80.                         Err.Clear
    
81.                         GoTo 300
    
82.                     End If
    
83.                     
    
84.                     If num3 < 0 Then GoTo 300
    
85.                     
    
86.                     If Abs(num3 - 24) < 0.0001 Then
    
87.                         a1 = arr1(1, loop1)
    
88.                         a2 = arr1(2, loop1)
    
89.                         a3 = arr1(3, loop1)
    
90.                         a4 = arr1(4, loop1)
    
91.                     
    
92.                         ss1 = Switch(s1 = 1, a1 & "+" & a2, _
    
93.                                         s1 = 2, a1 & "-" & a2, _
    
94.                                         s1 = 3, a1 & "×" & a2, _
    
95.                                         s1 = 4, a1 & "÷" & a2, _
    
96.                                         s1 = 5, a2 & "-" & a1, _
    
97.                                         s1 = 6, a2 & "÷" & a1)
    
98.                         ss2 = Switch(s2 = 1, ss1 & "+" & a3, _
    
99.                                         s2 = 2, ss1 & "-" & a3, _
    
100.                                         s2 = 3 And (s1 - 1) * (s1 - 2) * (s1 - 5) = 0, "(" & ss1 & ")×" & a3, _
     
101.                                         s2 = 3 And (s1 - 1) * (s1 - 2) * (s1 - 5) <> 0, ss1 & "×" & a3, _
     
102.                                         s2 = 4 And (s1 - 1) * (s1 - 2) * (s1 - 5) = 0, "(" & ss1 & ")÷" & a3, _
     
103.                                         s2 = 4 And (s1 - 1) * (s1 - 2) * (s1 - 5) <> 0, ss1 & "÷" & a3, _
     
104.                                         s2 = 5 And (s1 - 1) * (s1 - 2) * (s1 - 5) = 0, a3 & "-(" & ss1 & ")", _
     
105.                                         s2 = 5 And (s1 - 1) * (s1 - 2) * (s1 - 5) <> 0, a3 & "-" & ss1, _
     
106.                                         s2 = 6, a3 & "÷(" & ss1 & ")")
     
107.                                        
     
108.                         ' 根据不同的情况，添加括号
     
109.                         ss3 = Switch(s3 = 1, ss2 & "+" & a4, _
     
110.                                         s3 = 2, ss2 & "-" & a4, _
     
111.                                         s3 = 3 And (s2 - 1) * (s2 - 2) * (s2 - 5) = 0, "(" & ss2 & ")×" & a4, _
     
112.                                         s3 = 3 And (s2 - 1) * (s2 - 2) * (s2 - 5) <> 0, ss2 & "×" & a4, _
     
113.                                         s3 = 4 And (s2 - 1) * (s2 - 2) * (s2 - 5) = 0, "(" & ss2 & ")÷" & a4, _
     
114.                                         s3 = 4 And (s2 - 1) * (s2 - 2) * (s2 - 5) <> 0, ss2 & "÷" & a4, _
     
115.                                         s3 = 5 And (s2 - 1) * (s2 - 2) * (s2 - 5) = 0, a4 & "-(" & ss2 & ")", _
     
116.                                         s3 = 5 And (s2 - 1) * (s2 - 2) * (s2 - 5) <> 0, a4 & "-" & ss2, _
     
117.                                         s3 = 6, a4 & "÷(" & ss2 & ")")
     
118.                                                 
     
119.                         Sheets(1).[c4] = ss3 & "=24"
     
120.                         
     
121.                         Exit Sub
     
122.                     End If
     
123. 300
     
124.                 Next
     
125. 200
     
126.             Next
     
127. 100
     
128.         Next
     
129.     Next

复制代码

（未完，接下一段）

陈宫在家吗

Part 2：

（接上一段）

1.     ' 第二种情况：(a+b)+(c+d)
   
2.     For loop1 = 1 To UBound(arr1, 2)
   
3.         For s1 = 1 To 6 ' 分别代表第一个 + - * /
   
4.             num1 = 四则计算(arr1(1, loop1), arr1(2, loop1), s1)
   
5.             
   
6.             If Err <> 0 Then
   
7.                 Err.Clear
   
8.                 GoTo 150
   
9.             End If
   
10.             
    
11.             If num1 < 0 Then GoTo 150
    
12.             
    
13.             For s2 = 1 To 6
    
14.                 num2 = 四则计算(arr1(3, loop1), arr1(4, loop1), s2)
    
15.                
    
16.                 If Err <> 0 Then
    
17.                     Err.Clear
    
18.                     GoTo 250
    
19.                 End If
    
20.                
    
21.                 If num2 < 0 Then GoTo 250
    
22.                
    
23.                 For s3 = 1 To 6
    
24.                     num3 = 四则计算(num1, num2, s3)
    
25.                     
    
26.                     If Err <> 0 Then
    
27.                         Err.Clear
    
28.                         GoTo 350
    
29.                     End If
    
30.                     
    
31.                     If num3 < 0 Then GoTo 350
    
32.                     
    
33.                     If Abs(num3 - 24) < 0.0001 Then
    
34.                         a1 = arr1(1, loop1)
    
35.                         a2 = arr1(2, loop1)
    
36.                         a3 = arr1(3, loop1)
    
37.                         a4 = arr1(4, loop1)
    
38.                     
    
39.                         ss1 = Switch(s1 = 1, a1 & "+" & a2, _
    
40.                                         s1 = 2, a1 & "-" & a2, _
    
41.                                         s1 = 3, a1 & "×" & a2, _
    
42.                                         s1 = 4, a1 & "÷" & a2, _
    
43.                                         s1 = 5, a2 & "-" & a1, _
    
44.                                         s1 = 6, a2 & "÷" & a1)
    
45.                         ss2 = Switch(s2 = 1, a3 & "+" & a4, _
    
46.                                         s2 = 2, a3 & "-" & a4, _
    
47.                                         s2 = 3, a3 & "×" & a4, _
    
48.                                         s2 = 4, a3 & "÷" & a4, _
    
49.                                         s2 = 5, a4 & "-" & a3, _
    
50.                                         s2 = 6, a4 & "÷" & a3)
    
51.                                        
    
52.                         ' 根据不同的情况，添加括号
    
53.                         ss3 = Switch(s3 = 1, ss1 & "+" & ss2, _
    
54.                                         s3 = 2 And (s2 - 1) * (s2 - 2) * (s2 - 5) = 0, ss1 & "-(" & ss2 & ")", _
    
55.                                         s3 = 2 And (s2 - 1) * (s2 - 2) * (s2 - 5) <> 0, ss1 & "-" & ss2, _
    
56.                                         s3 = 3 And (s1 - 1) * (s1 - 2) * (s1 - 5) = 0 And (s2 - 1) * (s2 - 2) * (s2 - 5) = 0, "(" & ss1 & ")×(" & ss2 & ")", _
    
57.                                         s3 = 3 And (s1 - 1) * (s1 - 2) * (s1 - 5) = 0 And (s2 - 1) * (s2 - 2) * (s2 - 5) <> 0, "(" & ss1 & ")×" & ss2, _
    
58.                                         s3 = 3 And (s1 - 1) * (s1 - 2) * (s1 - 5) <> 0 And (s2 - 1) * (s2 - 2) * (s2 - 5) = 0, ss1 & "×(" & ss2 & ")", _
    
59.                                         s3 = 3 And (s1 - 1) * (s1 - 2) * (s1 - 5) <> 0 And (s2 - 1) * (s2 - 2) * (s2 - 5) <> 0, ss1 & "×" & ss2, _
    
60.                                         s3 = 4 And (s1 - 1) * (s1 - 2) * (s1 - 5) = 0, "(" & ss1 & ")÷(" & ss2 & ")", _
    
61.                                         s3 = 4 And (s1 - 1) * (s1 - 2) * (s1 - 5) <> 0, ss1 & "÷(" & ss2 & ")", _
    
62.                                         s3 = 5 And (s1 - 1) * (s1 - 2) * (s1 - 5) = 0, ss2 & "-(" & ss1 & ")", _
    
63.                                         s3 = 5 And (s1 - 1) * (s1 - 2) * (s1 - 5) <> 0, ss2 & "-" & ss1, _
    
64.                                         s3 = 6 And (s2 - 1) * (s2 - 2) * (s2 - 5) = 0, "(" & ss2 & ")÷(" & ss1 & ")", _
    
65.                                         s3 = 6 And (s2 - 1) * (s2 - 2) * (s2 - 5) <> 0, ss2 & "÷(" & ss1 & ")")
    
66.                                                 
    
67.                         Sheets(1).[c4] = ss3 & "=24"
    
68.                         
    
69.                         Exit Sub
    
70.                     End If
    
71. 350
    
72.                 Next
    
73. 250
    
74.             Next
    
75. 150
    
76.         Next
    
77.     Next
    
78.    
    
79. 
    
80.     Sheets(1).[c4] = "无法计算出24！"
    
81. 
    
82. End Sub
    

复制代码

这样就完成了，在B4~B7单元格中输入4个数字，在C4单元格中给出“计算24点”的算式。

ykcbf1100

不错的东东，感觉任何4个数都能有结果。

ykcbf1100

其实负数也能计算，楼主干么要避开负数呢？

ykcbf1100

我个人感觉if err语句没必要用，完全可以用On Error Resume Next代替。

goto语句都可以不用的。
我屏蔽掉这些语句，代码照样正常运行的。

micch

如果是用扑克牌，那数字就是1~13的范围内。4张牌全部可能性组合应该是不到2000种？然后每一种4张牌组合，算出一种计算式结果，做成数据库，用查表法就省事多了