世界最难的数组怎么赋值

micch

dongdonggege 发表于 2019-2-13 21:11
是match程序吧？

对，match过程中，判断等式成立原来用的是application.evaluate

换自定义函数判断。省得改match代码了

dongdonggege

micch 发表于 2019-2-13 21:14
对，match过程中，判断等式成立原来用的是application.evaluate

换自定义函数判断。省得改match代码了

很不错，我试了，谢谢老师，学习到很多东西，老师辛苦了。

爱疯

dongdonggege 发表于 2019-2-13 20:26
谢谢老师，我把你的代码改了。
我使用了9+5=9，3+6=3这两个算式能得到正确的算式。

Option Explicit

'6+4=4
'答案1，0+4=4
'答案2，8-4=4

Dim Exp, SelfDic, AddDic, DelDic, Result

'入口
Sub huocai()
    Dim i
    Exp = InputBox("移动一根火柴，使其成立", "", "6+4=4")
    Result = ""
    Call CreateData
    For i = 1 To Len(Exp)
        Call Rule(i, SelfDic)
        Call Rule(i, AddDic, True)    'True表示替换两次（也可先传DelDic，调用时再传AddDic）
    Next i
    Debug.Print Len(Result)
    MsgBox IIf(Len(Result), Result, "快去请如来佛祖..."), , "答案"
End Sub


'创建数据
Private Sub CreateData()
'按火柴数是否变化，分为两类：规则1 和 规则2

'规则1. 自变字符集
    Set SelfDic = CreateObject("scripting.dictionary")
    SelfDic("0") = Array(6, 9)
    SelfDic("2") = Array(3)
    SelfDic("3") = Array(2, 5)
    SelfDic("5") = Array(3)
    SelfDic("6") = Array(0, 9)
    SelfDic("9") = Array(0, 6)
    SelfDic("+") = Array("=")
    SelfDic("=") = Array("+")

    '规则2-1. 可加字符集
    Set AddDic = CreateObject("scripting.dictionary")
    AddDic("0") = Array(8)
    AddDic("1") = Array(7)
    AddDic("3") = Array(9)
    AddDic("5") = Array(6, 9)
    AddDic("6") = Array(8)
    AddDic("9") = Array(8)
    AddDic("-") = Array("=", "+")

    '规则2-2. 可减字符集
    Set DelDic = CreateObject("scripting.dictionary")
    DelDic("6") = Array(5)
    DelDic("7") = Array(1)
    DelDic("8") = Array(0, 6, 9)
    DelDic("9") = Array(3)
    DelDic("+") = Array("-")
    DelDic("=") = Array("-")

End Sub


'规则(位置, 字典, 是否替换两次)
Sub Rule(i, Dic, Optional IsTwo As Boolean = False)
    Dim ch, t, j, k, tmp, tmp2
    ch = Mid(Exp, i, 1)
    If Dic.exists(ch) Then
        t = Dic(ch)
        For j = LBound(t) To UBound(t)
            tmp = Exp
            Mid(tmp, i, 1) = t(j)

            If IsTwo Then
                tmp2 = Exp    '备份原始
                Exp = tmp    '拿已替换1次的去尝试
                For k = 1 To Len(Exp)    '遍历非i位置上的字符
                    If k <> i Then Call Rule(k, DelDic)
                Next k
            End If

            If IsEqual(tmp) Then Result = Result & vbLf & tmp
            If Len(tmp2) Then Exp = tmp2    '如果tmp2有内容，就用tmp2恢复原始
        Next j
    End If
End Sub


'判断
Function IsEqual(str) As Boolean
    Dim A, l, r
    A = Split(str, "=")
    If UBound(A) = 1 Then
        l = Application.Evaluate(A(0))
        r = Application.Evaluate(A(1))
        If VBA.IsNumeric(l) And VBA.IsNumeric(r) Then IsEqual = l = r
    End If
End Function

30.rar (87.88 KB, 下载次数: 2)

2019-2-14 21:40 上传

点击文件名下载附件

1）图片只为方便自己看字符是咋变的，没别的意义

2）x = "备份，调用，再备份 .... 恢复"
   在x之前，感觉舒畅；一到x处，就卡住了，想很久，没写出当调用加后再如何减，
   后来稀里糊涂试出现可得到结果的方法，不知还有没有错误，等学习

3）我没想出替换Evaluate的方式，等学习，你急用的话就用49楼吧

dongdonggege

爱疯 发表于 2019-2-14 22:01
Option Explicit

'6+4=4

老师，辛苦，许多算式都能运行。让你浪费很多时间，再次说辛苦了。
提几点意见，别不高兴。
1、正确的算式有时要请如来。
2、两位数能做出来吗？
3、这个程序能不能通用，在ppt中也能用，特别是这个函数evaluate在ppt中不能用啊！
4、想增加连加连减的功能也能使用。
我是不是得陇望蜀，老师别生气，你辛苦了。

dongdonggege

爱疯 发表于 2019-2-14 22:01
Option Explicit

'6+4=4

49楼在这Function js(eqs) As Boolean函数，Case 1: r = 0 + Mid(eqs, 3, 1) + Right(eqs, 1)类型不匹配。

dongdonggege

爱疯 发表于 2019-2-14 22:01
Option Explicit

'6+4=4

1+6=7，在Function IsEqual(str) As Boolean函数，r = Application.Evaluate(A(1))对象不支持该属性或方法。

爱疯

dongdonggege 发表于 2019-2-14 22:55
老师，辛苦，许多算式都能运行。让你浪费很多时间，再次说辛苦了。
提几点意见，别不高兴。
1、正确的 ...

'判断
Function IsEqual(str) As Boolean
    Dim A, B, i, j, tmp
    If UBound(Split(str, "=")) = 1 Then
        tmp = Replace(str, "-", "+-")
        A = Split(tmp, "=") '把等式分为左右两边
        For i = 0 To 1
            B = Split(A(i), "+") '把表达式拆成多个数
            A(i) = 0
            For j = 0 To UBound(B)
                A(i) = A(i) + 0 + B(j)
            Next j
        Next i
        IsEqual = A(0) = A(1)
    End If
End Function

31.rar (101.07 KB, 下载次数: 2)

2019-2-15 09:37 上传

点击文件名下载附件

可有多个加数，但只能是个位，不知能否想出来不是个位的

爱疯

dongdonggege 发表于 2019-2-14 23:02
1+6=7，在Function IsEqual(str) As Boolean函数，r = Application.Evaluate(A(1))对象不支持该属性或方 ...

http://club.excelhome.net/thread-1460844-1-1.html

昨天我也是第一次碰到的这情况，所以在问，等等看能否找到原因。你可以在那里说明你的操作系统和OFFICE版本，看看有没有人和你一样

爱疯

dongdonggege 发表于 2019-2-14 22:55
老师，辛苦，许多算式都能运行。让你浪费很多时间，再次说辛苦了。
提几点意见，别不高兴。
1、正确的 ...

16+16=35
答案
16+19=35
19+16=35



如果使用非个位数的加数，我只试成功1个，你多试几个，看有没有错误

dongdonggege

爱疯 发表于 2019-2-15 09:39
'判断
Function IsEqual(str) As Boolean
    Dim A, B, i, j, tmp

这版确实提高了不少!
1、好像也能做两位数了。
2、支持ppt的运行。
3、觉得应该加个原式与新式的比较。MsgBox "原式:" & vbCrLf & Exp & vbCrLf & "新式:" & IIf(Len(Result), Result, "没办法"), , "答案"。
我试了，原式:3+6=3，新式:9-6=3，3+0=3，3+6=9。总觉的3+6=9是好像错误。是不是定义的时候有问题。