ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 104|回复: 4

[求助] VBA在单元格中输入4个数字,加减乘除后得到24点,谢谢

[复制链接]

TA的精华主题

TA的得分主题

发表于 2024-5-7 12:20 | 显示全部楼层 |阅读模式
设计一个excel表格VBA程序,单元格输入四个数字,通过四个数字的加减乘除计算后结果为24,并显示计算过程

我在网上找的代码,好像出错,师傅可以不用我的代码,重写,谢谢:

Sub FindWayTo24()
    Dim nums(1 To 4) As Double
    Dim i As Integer, j As Integer, k As Integer, l As Integer
    Dim a As Double, b As Double, c As Double, d As Double
    Dim result As Double
    Dim found As Boolean

    ' 从单元格A1到A4获取四个数字
    For i = 1 To 4
        nums(i) = Cells(i, 1).Value
    Next i

    ' 尝试所有可能的组合
    found = False
    For i = 1 To 4
        a = nums(i)
        For j = 1 To 4
            If j <> i Then
                b = nums(j)
                For k = 1 To 4
                    If k <> i And k <> j Then
                        c = nums(k)
                        For l = 1 To 4
                            If l <> i And l <> j And l <> k Then
                                d = nums(l)
                                ' 尝试所有运算组合
                                result = TryOperations(a, b, c, d)
                                If result = 24 Then
                                    found = True
                                    ' 显示计算过程和结果
                                    Cells(6, 1).Value = "(" & a & " " & OperationString & " " & b & ") " & OperationString2 & " " & c & " " & OperationString3 & " " & d & " = 24"
                                    Exit For
                                End If
                            End If
                        Next l
                        If found Then Exit For
                    End If
                Next k
                If found Then Exit For
            End If
        Next j
        If found Then Exit For
    Next i

    If Not found Then
        Cells(6, 1).Value = "没有找到解决方案"
    End If
End Sub

Function TryOperations(a As Double, b As Double, c As Double, d As Double) As Double
    Dim operations As Variant
    operations = Array("+", "-", "*", "/")
    Dim i As Integer, j As Integer, k As Integer
    Dim result As Double

    For i = 0 To 3
        For j = 0 To 3
            For k = 0 To 3
                ' 尝试所有运算顺序
                result = Calculate(Calculate(Calculate(a, b, operations(i)), c, operations(j)), d, operations(k))
                If result = 24 Then
                    OperationString = operations(i)
                    OperationString2 = operations(j)
                    OperationString3 = operations(k)
                    TryOperations = result
                    Exit Function
                End If
            Next k
        Next j
    Next i
    TryOperations = 0
End Function

Function Calculate(a As Double, b As Double, op As String) As Double
    Select Case op
        Case "+"
            Calculate = a + b
        Case "-"
            Calculate = a - b
        Case "*"
            Calculate = a * b
        Case "/"
            If b <> 0 Then Calculate = a / b
    End Select
End Function



QQ截图20240507121356.png
QQ截图20240507121543.png

计算24点.zip

7.61 KB, 下载次数: 6

TA的精华主题

TA的得分主题

发表于 2024-5-7 13:00 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2024-5-7 13:39 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
taller 发表于 2024-5-7 13:00
请参考EH竞赛帖

https://club.excelhome.net/thread-508670-1-1.html?_dsign=906034c5

谢谢师傅,谢谢

TA的精华主题

TA的得分主题

发表于 2024-5-7 14:41 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2024-5-7 17:18 | 显示全部楼层
于箱长 发表于 2024-5-7 14:41
https://club.excelhome.net/thread-389641-2-1.html
看看香川群子老师的递归

谢谢箱长师傅。
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-5-19 19:30 , Processed in 0.044267 second(s), 12 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表