vba程序用7重循环来计算24

简介: vba程序用7重循环来计算24
'添加三件控件,F1单元格存放最大值
Sub Cal()
Dim t As Single
Dim Num(1 To 4)
t = Timer
For i = 1 To 4
    If Sheets(1).CheckBox1.Value Then Cells(1, i) = WorksheetFunction.RandBetween(1, Range("F1"))
    Num(i) = Cells(1, i)
Next
r = Cells(Rows.Count, 1).End(xlUp).Row + 1
Range("A2:B" & r) = ""
Application.ScreenUpdating = False
r = 3
For a = 1 To 4
    For b = 1 To 4
        For c = 1 To 4
            For d = 1 To 4
                For i = 1 To 4
                    For j = 1 To 4
                        For k = 1 To 4
                            If a <> b And a <> c And a <> d And b <> c And b <> d And c <> d Then
                                '无括号的运算
                                Cells(r, 1) = Num(a) & Sign(i) & Num(b) & Sign(j) & Num(c) & Sign(k) & Num(d) & " = "
                                Cells(r, 2) = "=" & Num(a) & Sign(i) & Num(b) & Sign(j) & Num(c) & Sign(k) & Num(d)
                                If Cells(r, 2) = 24 Then r = r + 1
                                '有括号运算(a b)c d
                                Cells(r, 1) = "(" & Num(a) & Sign(i) & Num(b) & ")" & Sign(j) & Num(c) & Sign(k) & Num(d) & " = "
                                Cells(r, 2) = "=" & "(" & Num(a) & Sign(i) & Num(b) & ")" & Sign(j) & Num(c) & Sign(k) & Num(d)
                                If Not IsError(Cells(r, 2)) Then '注意有括号要避免分母为0的情况
                                    If Cells(r, 2) = 24 Then r = r + 1
                                End If
                                '(a b c) d
                                Cells(r, 1) = "(" & Num(a) & Sign(i) & Num(b) & Sign(j) & Num(c) & ")" & Sign(k) & Num(d) & " = "
                                Cells(r, 2) = "=" & "(" & Num(a) & Sign(i) & Num(b) & Sign(j) & Num(c) & ")" & Sign(k) & Num(d)
                                If Not IsError(Cells(r, 2)) Then
                                    If Cells(r, 2) = 24 Then r = r + 1
                                End If
                                'a ( b c) d
                                Cells(r, 1) = Num(a) & Sign(i) & "(" & Num(b) & Sign(j) & Num(c) & ")" & Sign(k) & Num(d) & " = "
                                Cells(r, 2) = "=" & Num(a) & Sign(i) & "(" & Num(b) & Sign(j) & Num(c) & ")" & Sign(k) & Num(d)
                                If Not IsError(Cells(r, 2)) Then
                                    If Cells(r, 2) = 24 Then r = r + 1
                                End If
                                'a (b c d)
                                Cells(r, 1) = Num(a) & Sign(i) & "(" & Num(b) & Sign(j) & Num(c) & Sign(k) & Num(d) & ")" & " = "
                                Cells(r, 2) = "=" & Num(a) & Sign(i) & "(" & Num(b) & Sign(j) & Num(c) & Sign(k) & Num(d) & ")"
                                If Not IsError(Cells(r, 2)) Then
                                    If Cells(r, 2) = 24 Then r = r + 1
                                End If
                                'a b (c d)
                                Cells(r, 1) = Num(a) & Sign(i) & Num(b) & Sign(j) & "(" & Num(c) & Sign(k) & Num(d) & ")" & " = "
                                Cells(r, 2) = "=" & Num(a) & Sign(i) & Num(b) & Sign(j) & "(" & Num(c) & Sign(k) & Num(d) & ")"
                                If Not IsError(Cells(r, 2)) Then
                                    If Cells(r, 2) = 24 Then r = r + 1
                                End If
                                '(a b) (c d)
                                Cells(r, 1) = "(" & Num(a) & Sign(i) & Num(b) & ")" & Sign(j) & "(" & Num(c) & Sign(k) & Num(d) & ")" & " = "
                                Cells(r, 2) = "=" & "(" & Num(a) & Sign(i) & Num(b) & ")" & Sign(j) & "(" & Num(c) & Sign(k) & Num(d) & ")"
                                If Not IsError(Cells(r, 2)) Then
                                    If Cells(r, 2) = 24 Then r = r + 1
                                End If
                            End If
                        Next
                    Next
                Next
            Next
        Next
    Next
Next
If Cells(r, 2) <> 24 Then Range("A" & r & ":B" & r) = ""
r = Cells(Rows.Count, 1).End(xlUp).Row
If r = 1 Then
    Cells(2, 1) = "此四数无解!"
    Exit Sub
Else
    Cells(2, 1) = "共" & r - 2 & "种解法"
End If
'以下去掉重复解法,如不计重新以下代码除最后2行可以全部删除
'只要公式的字串不同即算一种解法,而不考虑交换律、结合律、运算符等级的实质相同。
For j = r To 4 Step -1
    For i = 3 To j - 1
        If Cells(j, 1) = Cells(i, 1) Then
            Cells(j, 1) = ""
            Cells(j, 2) = ""
        End If
    Next
Next
'以下删除空行后重新计算行数
For i = r To 3 Step -1
    If Cells(i, 1) = "" Then
        Rows(i).Delete
    End If
Next
r = Cells(Rows.Count, 1).End(xlUp).Row
Cells(2, 1) = "共" & r - 2 & "种解法"
'计算时间
Cells(2, 1) = Cells(2, 1) & ",耗时" & Timer - t & "秒。"
Application.ScreenUpdating = True
End Sub
Function Sign(x)
Select Case x
    Case 1: Sign = " + "
    Case 2: Sign = " - "
    Case 3: Sign = " * "
    Case 4: Sign = " / "
End Select
End Function

20201212103037800.jpg


目录
相关文章
Labview在循环的每次迭代中将数据写入Excel文件
Labview在循环的每次迭代中将数据写入Excel文件
106 0
|
3月前
|
测试技术
hyengine 编译问题之取出具体数值如何解决
hyengine 编译问题之取出具体数值如何解决
|
5月前
|
存储 算法 Swift
Swift开发——循环执行方式
Swift语言中的循环主要包括`for-in`和`while`结构。`for-in`适用于遍历数字区间、字符串和字典,支持使用`stride`函数定制步进。字典遍历时,可以用二元元组`(k, v)`访问键值对。`while`循环有标准形式和`repeat-while`形式,确保至少执行一次循环体。程序示例展示了`for-in`和不同`while`结构的用法,包括计算阶乘、奇数和、加密字符串以及最大公约数和最小公倍数。
35 0
Swift开发——循环执行方式
|
5月前
|
数据格式 Windows
必知的技术知识:Excel公式SWITCH函数你用过吗?多种查找函数介绍
必知的技术知识:Excel公式SWITCH函数你用过吗?多种查找函数介绍
78 0
#PY小贴士# for 循环定义的变量,循环外可以用吗?
我们知道,在 python 中要获取一个变量的值,必须是先给它赋值过,不然就是未定义。那么这个 i,代码中没有显式的赋值,在循环体之外还可以用吗?
|
Java Shell 程序员
shel脚本基础系列(三)for-while循环
shel脚本基础系列(三)for-while循环
207 0
shel脚本基础系列(三)for-while循环
for循环执行的速度快于其内部的点击响应函数
for循环执行的速度快于其内部的点击响应函数
114 0
for循环执行的速度快于其内部的点击响应函数
|
自然语言处理
在以阶段划分的编译过程中,判断程序语句的形式是否正确属于()阶段的工作。
在以阶段划分的编译过程中,判断程序语句的形式是否正确属于()阶段的工作。
180 0