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-16 20:02 | 显示全部楼层
micch 发表于 2019-2-16 19:05
77楼这个代码,是原来的吧。

24行那里,用的判断还是evaluate,没改为自定义函数,所以PPT不能用?

老师,我找到现在,找不到你的附件了,需要新的附件,还是爱疯老师的附件?

TA的精华主题

TA的得分主题

发表于 2019-2-16 20:14 | 显示全部楼层
dongdonggege 发表于 2019-2-16 20:02
老师,我找到现在,找不到你的附件了,需要新的附件,还是爱疯老师的附件?

http://club.excelhome.net/forum. ... 499&pid=9820703

10楼的附件,自己改改吧,懒得重新压缩上传了。

AA列是一些可以变化的等式,自己可以增加一些试试。可以手动输入等式判断成立与否。可以随机,不过两位数随机等式大多是不成立的,所以还是自己设计一些等式测试吧。

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-2-16 20:57 | 显示全部楼层
micch 发表于 2019-2-16 19:05
77楼这个代码,是原来的吧。

24行那里,用的判断还是evaluate,没改为自定义函数,所以PPT不能用?

改出来了,brr(n,0),空值怎么让它不打印出来呢?
  1. Sub tt()
  2.     Randomize '随机生成等式并测试成立与否
  3.     ss = Mid("+-x", 1 + Rnd() * 2, 1)
  4.     ss = Int(Rnd() * 66) & ss & Int(Rnd() * 66) & "=" & Int(Rnd() * 66)
  5.     [f11] = ss '存放等式的位置,自行更改,上一行随机的数字自行修改
  6.     [f13].Resize(9).ClearContents
  7.     match
  8. End Sub

  9. Sub match()
  10.     Dim d, arr, ar, brr(9, 0), i%, k%, n%, ss$, x, a, b
  11.     Set d = CreateObject("Scripting.Dictionary")
  12.     ReDim arr(1 To 12, 1 To 5) As String
  13.     Set d = CreateObject("Scripting.Dictionary")
  14.     arr(1, 1) = 0: arr(1, 2) = 6: arr(1, 3) = 8: arr(1, 4) = "*": arr(1, 5) = "6,9"
  15.     arr(2, 1) = 1: arr(2, 2) = 2: arr(2, 3) = 7: arr(2, 4) = "*": arr(2, 5) = "*"
  16.     arr(3, 1) = 2: arr(3, 2) = 5: arr(3, 3) = "*": arr(3, 4) = "*": arr(3, 5) = "3"
  17.     arr(4, 1) = 3: arr(4, 2) = 5: arr(4, 3) = 9: arr(4, 4) = "*": arr(4, 5) = "2,5"
  18.     arr(5, 1) = 4: arr(5, 2) = 4: arr(5, 3) = "*": arr(5, 4) = "*": arr(5, 5) = "*"
  19.     arr(6, 1) = 5: arr(6, 2) = 5: arr(6, 3) = "6,9": arr(6, 4) = "*": arr(6, 5) = "3"
  20.     arr(7, 1) = 6: arr(7, 2) = 6: arr(7, 3) = 8: arr(7, 4) = 5: arr(7, 5) = "0,9"
  21.     arr(8, 1) = 7: arr(8, 2) = 3: arr(8, 3) = "*": arr(8, 4) = 1: arr(8, 5) = "*"
  22.     arr(9, 1) = 8: arr(9, 2) = 7: arr(8, 3) = "*": arr(9, 4) = "0,6,9": arr(9, 5) = "*"
  23.     arr(10, 1) = 9: arr(10, 2) = 6: arr(10, 3) = 8: arr(10, 4) = "3,5": arr(10, 5) = "0,6"
  24.     arr(11, 1) = "+": arr(11, 2) = 2: arr(11, 3) = "*": arr(11, 4) = "-": arr(11, 5) = "*"
  25.     arr(12, 1) = "-": arr(12, 2) = 3: arr(12, 3) = "+": arr(12, 4) = "*": arr(12, 5) = "*"
  26.     For i = 1 To 12
  27.         d(arr(i, 1) & "+") = arr(i, 3)
  28.         d(arr(i, 1) & "-") = arr(i, 4)
  29.         d(arr(i, 1) & "c") = arr(i, 5)
  30.     Next
  31.     ss = "9+5=9"
  32.     ss = Replace(ss, "x", "*")
  33.     For i = 1 To Len(ss)
  34.         x = Mid(ss, i, 1)
  35.         If x = "=" And InStr(ss, "-") Then '等号与减号互换后成立判断
  36.             eqs = Replace(Replace(ss, "=", "-"), "-", "=", , 1)
  37.             If js(eqs) Then brr(n, 0) = eqs: n = n + 1
  38.         Else
  39.             If d(x & "c") <> "*" Then '原数字内移动一根后成立判断
  40.                 For Each a In Split(d(x & "c"), ",")
  41.                     eqs = Mid(Mid(" " & ss, 1, i) & Replace(ss, x, a, i, 1), 2)
  42.                     If js(eqs) Then brr(n, 0) = Replace(eqs, "*", "x"): n = n + 1
  43.                 Next
  44.             End If
  45.             If d(x & "-") <> "*" Then '一处减少另一处增加一根后成立判断
  46.                 For Each a In Split(d(x & "-"), ",")
  47.                     eqs = Mid(Mid(" " & ss, 1, i) & Replace(ss, x, a, i, 1), 2)
  48.                     For k = 1 To Len(eqs)
  49.                         If k <> i And d(Mid(eqs, k, 1) & "+") <> "*" Then
  50.                             For Each b In Split(d(Mid(eqs, k, 1) & "+"), ",")
  51.                                 eqs2 = Mid(Mid(" " & eqs, 1, k) & Replace(eqs, Mid(eqs, k, 1), b, k, 1), 2)
  52.                                 If js(eqs2) Then brr(n, 0) = Replace(eqs2, "*", "x"): n = n + 1
  53.                             Next b
  54.                         End If
  55.                     Next k
  56.                 Next a
  57.             End If
  58.         End If
  59.     Next i
  60.     '[f13].Resize(9).ClearContents
  61.     If n Then
  62.         '[f13].Resize(n + 1) = brr
  63.         For n = 0 To 9
  64.             Debug.Print brr(n, 0) '空值怎么不打印出来呢
  65.         Next
  66.     Else
  67.         '[f13] = "I can't do it!"
  68.         For n = 0 To 9
  69.             Debug.Print brr(n, 0) '空值怎么不打印出来呢
  70.         Next
  71.     End If
  72. End Sub

  73. Function js(eqs) As Boolean
  74.     If InStr(eqs, "=") Then
  75.         eqs1 = eqs
  76.         eqs = Replace(Replace(eqs, "x", "*"), "-", "+-")
  77.         L = Split(eqs, "=")(0)
  78.         R = Split(eqs, "=")(1)
  79.         If InStr(L, "*") Then L = Val(L) * Mid(L, InStr(L, "*") + 1)
  80.         If InStr(R, "*") Then R = Val(R) * Mid(R, InStr(R, "*") + 1)
  81.         If InStr(L, "+") Then L = Val(L) + Mid(L, InStr(L, "+") + 1)
  82.         If InStr(R, "+") Then R = Val(R) + Mid(R, InStr(R, "+") + 1)
  83.         If L - R = 0 Then js = True
  84.         eqs = eqs1
  85.     End If
  86. End Function
复制代码

这样的word,excle,ppt就通用了。老师看看。

TA的精华主题

TA的得分主题

发表于 2019-2-16 21:03 | 显示全部楼层
67到71删除,就是等式不成立的时候,什么也不操作。

既然你是手工输入要测试的等式,32行。那么随机生成等式的代码就都不需要了,9行以上都删除。

15到31行,既然不想引用表格的数据,那么直接加字典就行了,写那么多代码太复杂了。

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-2-16 21:18 | 显示全部楼层
micch 发表于 2019-2-16 21:03
67到71删除,就是等式不成立的时候,什么也不操作。

既然你是手工输入要测试的等式,32行。那么随机生成 ...

麻烦老师,干脆,你把简略的代码贴出来。

TA的精华主题

TA的得分主题

发表于 2019-2-16 21:30 | 显示全部楼层
只给你写个例子,懒得做这种无用功。

以数字6为例。  d("6+")=8:d("6-")=5:d("6c")="0,9"

只需要把能移动的可能加入字典就行,不能变化的就不用管了。

过程中判断 if d(*****) <> "*" 是判断不能变化,现在字典里没有,所以直接用d.exists(***)就行了

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-2-16 22:37 | 显示全部楼层
micch 发表于 2019-2-16 21:30
只给你写个例子,懒得做这种无用功。

以数字6为例。  d("6+")=8:d("6-")=5:d("6c")="0,9"

谢谢老师了。

TA的精华主题

TA的得分主题

发表于 2019-2-16 22:46 | 显示全部楼层
Option Explicit

Dim Dic1, Dic2, Dic3, result

'入口
Sub huocai()
    Dim Exp
    Exp = InputBox("移动一根火柴,使其成立", "提问", "6+9=13")
    If Exp = "" Then End
    If IsExp(Exp) = False Then MsgBox "不是算术等式", , "提示": End

    result = Exp & vbLf & "可变成"
    Call data
    Call char1(Exp, Dic1)
    Call char2(Exp, Dic2)
    MsgBox IIf(Len(result) > Len(Exp) + 4, result, "没办法"), , "回答"
End Sub


'创建数据
Private Sub data()

'1. 一个字符变化:改变自身,变为另一个数
    Set Dic1 = CreateObject("scripting.dictionary")
    Dic1("0") = Array(6, 9)
    Dic1("2") = Array(3)
    Dic1("3") = Array(2, 5)
    Dic1("5") = Array(3)
    Dic1("6") = Array(0, 9)
    Dic1("9") = Array(0, 6)
    Dic1("+") = Array("=")
    Dic1("=") = Array("+")

    '2-1. 可加:增加一根火柴,变为另一个数
    Set Dic2 = CreateObject("scripting.dictionary")
    Dic2("0") = Array(8)
    Dic2("1") = Array(7)
    Dic2("3") = Array(9)
    Dic2("5") = Array(6, 9)
    Dic2("6") = Array(8)
    Dic2("9") = Array(8)
    Dic2("-") = Array("=", "+")

    '2-2. 可减:减少一根火柴,变为另一个数
    Set Dic3 = CreateObject("scripting.dictionary")
    Dic3("6") = Array(5)
    Dic3("7") = Array(1)
    Dic3("8") = Array(0, 6, 9)
    Dic3("9") = Array(3, 5)
    Dic3("+") = Array("-")
    Dic3("=") = Array("-")

End Sub

'一个字符变化(表达式,字典)
Sub char1(Exp, d)
    Dim i, j, ch, A, str
    For i = 1 To Len(Exp)
        ch = Mid(Exp, i, 1)
        If d.exists(ch) Then
            A = d(ch)
            For j = LBound(A) To UBound(A)
                str = Exp
                Mid(str, i, 1) = A(j)
                If IsEqual(str) And InStr(result, str) = 0 Then result = result & vbLf & str
            Next j
        End If
    Next i
End Sub

'二个字符变化(表达式,字典)
Sub char2(Exp, d)
    Dim ch, A, i, j, k, exp1
    For i = 1 To Len(Exp)
        ch = Mid(Exp, i, 1)
        If d.exists(ch) Then
            A = d(ch)
            For j = LBound(A) To UBound(A)
                exp1 = Exp
                Mid(exp1, i, 1) = A(j)
                Call char1(exp1, Dic3)
            Next j
        End If
    Next i
End Sub


'判断两边之和是否相等
Function IsEqual(str) As Boolean
    Dim A, B, i, j, str2
    If IsExp(str) = False Then Exit Function
    str2 = Replace(str, "-", "+-")
    A = Split(str2, "=")

    For i = 0 To 1
        B = Split(A(i), "+")
        A(i) = 0
        For j = 0 To UBound(B)
            If B(j) = "" Then B(j) = 0
            A(i) = A(i) + 0 + B(j)
        Next j
    Next i
    IsEqual = A(0) = A(1)
End Function


'判断表达式
'1. 只能包含数字,加号,减号,等号
'2. 只有1个等号
'3. 不允许++ -- +- -+
Function IsExp(str) As Boolean
    Dim i, c, str2, A
    Dim tj1, tj2, tj3

    tj1 = True
    str2 = "0123456789-+="
    For i = 1 To Len(str)
        c = Mid(str, i, 1)
        If InStr(str2, c) = 0 Then tj1 = False: Exit For
    Next i

    tj2 = UBound(Split(str, "=")) = 1
    tj3 = True
    A = Array("++", "--", "+-", "-+")
    For i = 0 To UBound(A)
        If InStr(str, A(i)) Then tj3 = False: Exit For
    Next i

    IsExp = tj1 And tj2 And tj3
End Function




41.rar (93.3 KB, 下载次数: 5)

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-2-16 23:06 | 显示全部楼层
本帖最后由 dongdonggege 于 2019-2-17 17:36 编辑
爱疯 发表于 2019-2-16 22:46
Option Explicit

Dim Dic1, Dic2, Dic3, result

这版特别好,牛人,老师。26+36=51,两边都是两位数,也能做出来。
老师,辛苦了,老师你也早点休息,明天再测试吧,。

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-2-17 21:44 | 显示全部楼层
爱疯 发表于 2019-2-16 22:46
Option Explicit

Dim Dic1, Dic2, Dic3, result

老师,我想推荐你看下这个:http://tieba.baidu.com/p/5669949536,用vb做的,可以做移动两根火柴棒的,也许能有启发,可惜我看不懂。
你的程序,乘法好像不能做,我用*或×都不能计算5×3=9。
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关闭

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

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

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

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

Powered by Discuz! X3.4

© 1999-2020 Wooffice Inc.

   

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

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

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