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 18:50 | 显示全部楼层
dongdonggege 发表于 2019-2-13 12:59
那你看规则怎么修改?

规则怎么改都行,就是限定个范围而已。

做一个简单的规则:个位数运算,+-*三种运算符。=不能变+,因为没等号了。=只能喝-互换,因为*号是两个斜的火柴,不能动。
大致就这些吧。

你说的对,应该是做一个判断成立与否的自定义函数,然后调用。可惜我才学没多久,还不会自定义函数,只好在一个过程中循环判断了。

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-2-13 19:08 | 显示全部楼层
micch 发表于 2019-2-13 18:02
思路不对,就费功夫,用循环做了一个,写的真长。结果除法的时候出现除0的错误,懒得改了,只做+-*的等式。 ...

老师,你的附件能上传吗?

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-2-13 19:13 | 显示全部楼层
micch 发表于 2019-2-13 18:02
思路不对,就费功夫,用循环做了一个,写的真长。结果除法的时候出现除0的错误,懒得改了,只做+-*的等式。 ...

另外,excel支持Application.Evaluate,ppt不支持,请问能否修改这句话。

TA的精华主题

TA的得分主题

发表于 2019-2-13 19:26 | 显示全部楼层
本帖最后由 micch 于 2019-2-13 19:28 编辑
dongdonggege 发表于 2019-2-13 19:13
另外,excel支持Application.Evaluate,ppt不支持,请问能否修改这句话。

match - 副本.zip (22.37 KB, 下载次数: 12)

评分

参与人数 1财富 +10 收起 理由
满坛皆为吾师 + 10

查看全部评分

TA的精华主题

TA的得分主题

发表于 2019-2-13 19:28 | 显示全部楼层
本帖最后由 爱疯 于 2019-2-13 19:29 编辑

QQ截图20190213192814.jpg
huocai3.rar (22.87 KB, 下载次数: 4)

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-2-13 20:26 | 显示全部楼层
爱疯 发表于 2019-2-13 19:28
没偷懒的判断和循环,很泄气。。。。。
要试下不知还有没有错。

谢谢老师,我把你的代码改了。
我使用了9+5=9,3+6=3这两个算式能得到正确的算式。
  1. Option Explicit

  2. '6+4=4
  3. '答案1,0+4=4
  4. '答案2,8-4=4

  5. '火柴
  6. Sub hc()
  7.     Dim i, j, k, c, x, y, z, s, p, q
  8.     'A列是变化前,B列变化后,C列变化类型
  9.     '后半部分(15到28)是前半部分(1到14)的逆操作
  10.     'A = Range("a1").CurrentRegion
  11.     Dim A() As String
  12.     ReDim A(1 To 28, 1 To 3) As String
  13.     A(1, 1) = 0: A(1, 2) = 6: A(1, 3) = "自变": A(2, 1) = 0: A(2, 2) = 8: A(2, 3) = "自变"
  14.     A(3, 1) = 0: A(3, 2) = 9: A(3, 3) = "自变": A(4, 1) = 1: A(4, 2) = 7: A(4, 3) = "自变"
  15.     A(5, 1) = 1: A(5, 2) = "+": A(5, 3) = "+": A(6, 1) = 3: A(6, 2) = 9: A(6, 3) = "+"
  16.     A(7, 1) = 5: A(7, 2) = 6: A(7, 3) = "+": A(8, 1) = 5: A(8, 2) = 9: A(8, 3) = "+"
  17.     A(9, 1) = 6: A(9, 2) = 8: A(9, 3) = "+": A(10, 1) = 6: A(10, 2) = 9: A(10, 3) = "+"
  18.     A(11, 1) = 8: A(11, 2) = 9: A(11, 3) = "+": A(12, 1) = 11: A(12, 2) = "+": A(12, 3) = "自变"
  19.     A(13, 1) = "-": A(13, 2) = "+": A(13, 3) = "+": A(14, 1) = "-": A(14, 2) = "+": A(14, 3) = "="
  20.     A(15, 1) = 6: A(15, 2) = 0: A(15, 3) = "自变": A(16, 1) = 8: A(16, 2) = 0: A(16, 3) = "自变"
  21.     A(17, 1) = 9: A(17, 2) = 0: A(17, 3) = "自变": A(18, 1) = 7: A(18, 2) = 1: A(18, 3) = "自变"
  22.     A(19, 1) = "+": A(19, 2) = 1: A(19, 3) = "-": A(20, 1) = 9: A(20, 2) = 3: A(20, 3) = "-"
  23.     A(21, 1) = 6: A(21, 2) = 5: A(21, 3) = "-": A(22, 1) = 9: A(22, 2) = 5: A(22, 3) = "-"
  24.     A(23, 1) = 8: A(23, 2) = 6: A(23, 3) = "-": A(24, 1) = 9: A(24, 2) = 6: A(24, 3) = "-"
  25.     A(25, 1) = 9: A(25, 2) = 8: A(25, 3) = "-": A(26, 1) = "+": A(26, 2) = 11: A(26, 3) = "自变"
  26.     A(27, 1) = "+": A(27, 2) = "-": A(27, 3) = "-": A(28, 1) = "=": A(28, 2) = "-": A(28, 3) = "-"
  27.     x = InputBox("移动一根火柴,使其成立", "问题", "6+4=4")
  28.     s = x & vbLf & "可变成" & vbLf & vbLf

  29.     '1. 遍历所有字符
  30.     For i = 1 To Len(x)
  31.         c = Mid(x, i, 1)    '比如,返回"6"
  32.         If InStr("011356789-+=", c) Then

  33.             '2. 遍历所有结果
  34.             For j = 1 To UBound(A)
  35.                 If c = CStr(A(j, 1)) Then

  36.                     '3. 按变化类型,选不同规则
  37.                     If A(j, 3) = "自变" Then

  38.                         '3-1 自变,指只有自身一个字符变化。比如 6变0
  39.                         y = x    '备份
  40.                         Mid(y, i, Len(A(j, 2))) = A(j, 2)    'Mid(字符串, 替换位置, 替换长度) = 用于替换的子串
  41.                         If f(y) Then If InStr(s, y) = 0 Then s = s & vbLf & y

  42.                     Else

  43.                         '3-2 因变,和另一个字符同时变化
  44.                         '3-2-1 因变_字符1,总是需要变的,所以提取出来
  45.                         y = x
  46.                         Mid(y, i, Len(A(j, 2))) = A(j, 2)
  47.                         '3-2-2 因变_字符2
  48.                         p = 1  '扫过位置
  49.                         If A(j, 3) = "+" Then
  50.                             '则另一个字符必是可减,比如 8变6
  51.                             For k = 1 To UBound(A)
  52.                                 If A(k, 3) = "-" Then
  53.                                     q = InStr(p, y, A(k, 1))    '字符2的当前位置
  54.                                     If q > 0 Then
  55.                                         p = q
  56. '                                        Debug.Print y, A(k, 1), "扫完" & p, "当前" & q
  57.                                         z = y
  58.                                         Mid(z, q, Len(A(k, 1))) = A(k, 2)
  59.                                         If f(z) Then If InStr(s, z) = 0 Then s = s & vbLf & z
  60.                                     End If
  61.                                 End If
  62.                             Next k
  63.                         ElseIf A(j, 3) = "-" Then
  64.                             '则另一个字符必是可加,比如 6变8
  65.                             For k = 1 To UBound(A)
  66.                                 If A(k, 3) = "+" Then
  67.                                     q = InStr(p, y, A(k, 1))
  68.                                     If q > 0 Then
  69.                                         p = q
  70.                                         z = y
  71.                                         Mid(z, q, Len(A(k, 1))) = A(k, 2)
  72.                                         If f(z) Then If InStr(s, z) = 0 Then s = s & vbLf & z
  73.                                     End If
  74.                                 End If
  75.                             Next k
  76.                         End If

  77.                     End If

  78.                 End If
  79.             Next j

  80.         End If
  81.     Next i

  82.     MsgBox IIf(Len(s) = 12, "快去请如来佛祖!", s), , "答案"
  83. End Sub

  84. '判断
  85. Function f(s) As Boolean
  86.     Dim arr, l, r
  87.     If InStr(s, "=") Then
  88.         arr = VBA.Split(s, "=")
  89.         l = Application.Evaluate(arr(0))
  90.         r = Application.Evaluate(arr(1))
  91.         If VBA.IsNumeric(l) And VBA.IsNumeric(r) Then
  92.             If l = r Then f = True
  93.         End If
  94.     End If
  95. End Function
复制代码

因为我最常用ppt的。这里有个问题,在ppt中,Application.Evaluate不能使用,我不知道怎么替换。能换掉吗?

TA的精华主题

TA的得分主题

发表于 2019-2-13 20:32 | 显示全部楼层
本帖最后由 micch 于 2019-2-13 20:38 编辑
dongdonggege 发表于 2019-2-13 19:13
另外,excel支持Application.Evaluate,ppt不支持,请问能否修改这句话。
  1. Function js(eqs) As Boolean
  2.     If "=" = Mid(eqs, 4, 1) Then
  3.         m = InStr("+-*", Mid(eqs, 2, 1))
  4.         Select Case m
  5.             Case 1: L = 0 + Left(eqs, 1) + Mid(eqs, 3, 1)
  6.             Case 2: L = Left(eqs, 1) - Mid(eqs, 3, 1)
  7.             Case 3: L = Left(eqs, 1) * Mid(eqs, 3, 1)
  8.         End Select
  9.         R = Right(eqs, 1)
  10.     Else
  11.         m = InStr("+-*", Mid(eqs, 4, 1))
  12.         Select Case m
  13.             Case 1: R = 0 + Mid(eqs, 3, 1) + Right(eqs, 1)
  14.             Case 2: R = Mid(eqs, 3, 1) - Right(eqs, 1)
  15.             Case 3: R = Mid(eqs, 3, 1) * Right(eqs, 1)
  16.         End Select
  17.         L = Left(eqs, 1)
  18.     End If
  19.     If L - R = 0 Then js = True
  20. End Function
复制代码


写个笨笨的计算代码,仅限于个位数计算。判断等号两边是否相等,等号可以是第二,第四位,但必须有等号。

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-2-13 21:04 | 显示全部楼层
micch 发表于 2019-2-13 20:32
写个笨笨的计算代码,仅限于个位数计算。判断等号两边是否相等,等号可以是第二,第四位,但必须有等 ...

这个函数没看懂,是连接哪个程序的?

TA的精华主题

TA的得分主题

发表于 2019-2-13 21:08 | 显示全部楼层
本帖最后由 micch 于 2019-2-13 21:13 编辑
dongdonggege 发表于 2019-2-13 21:04
这个函数没看懂,是连接哪个程序的?

就是替换application.evaluate 那个if的条件区域(红色部分)

改为if js(eqs) then .............

补充一下乘号的问题,如果用的是x不是*
Function js(eqs) As Boolean
    If "=" = Mid(eqs, 4, 1) Then
        m = InStr("+-*x", Mid(eqs, 2, 1))
        Select Case m
            Case 1: L = 0 + Left(eqs, 1) + Mid(eqs, 3, 1)
            Case 2: L = Left(eqs, 1) - Mid(eqs, 3, 1)
            Case Else: L = Left(eqs, 1) * Mid(eqs, 3, 1)
        End Select
        R = Right(eqs, 1)
    Else
        m = InStr("+-*x", Mid(eqs, 4, 1))
        Select Case m
            Case 1: R = 0 + Mid(eqs, 3, 1) + Right(eqs, 1)
            Case 2: R = Mid(eqs, 3, 1) - Right(eqs, 1)
            Case Else: R = Mid(eqs, 3, 1) * Right(eqs, 1)
        End Select
        L = Left(eqs, 1)
    End If
    If L - R = 0 Then js = True
End Function

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-2-13 21:11 | 显示全部楼层
micch 发表于 2019-2-13 20:32
写个笨笨的计算代码,仅限于个位数计算。判断等号两边是否相等,等号可以是第二,第四位,但必须有等 ...

是match程序吧?
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关闭

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

关注官方微信,每天学会一个新技能

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

GMT+8, 2019-10-16 05:19 , Processed in 0.076141 second(s), 15 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2020 Wooffice Inc.

   

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

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

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