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


目录
相关文章
|
8月前
|
Python
循环结构程序设置
循环结构程序设置
61 0
Labview在循环的每次迭代中将数据写入Excel文件
Labview在循环的每次迭代中将数据写入Excel文件
130 0
|
7月前
循环编程计算
循环编程计算
36 0
|
8月前
|
Python
[重学Python] Day1 变量+分支+循环
[重学Python] Day1 变量+分支+循环
61 3
|
8月前
|
Java 大数据 数据处理
获取到数据循环写文件
这段代码是一个Java方法,用于分批处理数据。它定义了初始值和每批处理的数量,然后通过`PageInfo`对象获取数据。如果总数小于1,则直接返回空列表。否则,循环处理数据,防止环境中的多次空跳过,并在处理完一批数据后更新页码。代码中还提到,这个过程可以用于减少大数据操作带来的风险。此外,配有一张动图,可能表示数据处理的过程。
52 1
|
8月前
|
存储 Python
[重学Python]Day3 函数和模块的使用
本文介绍了Python中的函数和模块的使用。函数用于避免代码重复,通过`def`定义,参数可有默认值或可变参数。模块管理同名函数,通过`import`导入。示例包括计算最大公约数和最小公倍数、判断回文数和素数的函数,以及检测回文素数的程序。
51 0
|
Java Shell 程序员
shel脚本基础系列(三)for-while循环
shel脚本基础系列(三)for-while循环
221 0
shel脚本基础系列(三)for-while循环
for循环执行的速度快于其内部的点击响应函数
for循环执行的速度快于其内部的点击响应函数
120 0
for循环执行的速度快于其内部的点击响应函数