ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

EH搜索     
EH云课堂-专业的职场技能充电站 Excel转在线管理系统,怎么做看这里 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! Excel 2016函数公式学习大典 EH云课堂直播课程免费学 打造核心竞争力的职场宝典
300集Office 2010微视频教程 Tableau-数据可视化工具 精品推荐-800套精选PPT模板,点击获取 ExcelHome出品 - VBA代码宝免费下载
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 Excel VBA经典代码实践指南
楼主: dongdonggege

[求助] 世界最难的数组怎么赋值

[复制链接]

TA的精华主题

TA的得分主题

发表于 2019-2-13 21:14 | 显示全部楼层

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

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

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-2-13 21:24 | 显示全部楼层
micch 发表于 2019-2-13 21:14
对,match过程中,判断等式成立原来用的是application.evaluate

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

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

TA的精华主题

TA的得分主题

发表于 2019-2-14 22:01 | 显示全部楼层
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)

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-2-14 22:55 | 显示全部楼层
爱疯 发表于 2019-2-14 22:01
Option Explicit

'6+4=4

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

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-2-14 22:58 | 显示全部楼层
爱疯 发表于 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)类型不匹配。

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-2-14 23:02 | 显示全部楼层
爱疯 发表于 2019-2-14 22:01
Option Explicit

'6+4=4

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

TA的精华主题

TA的得分主题

发表于 2019-2-15 09:39 | 显示全部楼层
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)

TA的精华主题

TA的得分主题

发表于 2019-2-15 10:15 | 显示全部楼层
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版本,看看有没有人和你一样

TA的精华主题

TA的得分主题

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

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



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

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-2-15 12:05 | 显示全部楼层
爱疯 发表于 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是好像错误。是不是定义的时候有问题。
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关闭

最新热点上一条 /1 下一条

关注官方微信,高效办公专列,每天发车

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

GMT+8, 2019-10-16 05:23 , Processed in 0.078187 second(s), 11 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2020 Wooffice Inc.

   

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

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

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