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 17:31 | 显示全部楼层
micch 发表于 2019-2-16 17:13
14+1=11  怎么可能变成4+7=11  14变4那不是少了两根火柴??7那才多了一根,还有一根去哪了?

没那么难吧,14变4,减少1根;1变7,增加1根。总的,不是移动1根?

TA的精华主题

TA的得分主题

发表于 2019-2-16 17:44 来自手机 | 显示全部楼层
dongdonggege 发表于 2019-2-16 17:31
没那么难吧,14变4,减少1根;1变7,增加1根。总的,不是移动1根?

你首先要确定好每个数字和符号的火柴个数。按照8由7根组成,的原则,1就必须由2根组成。这样的话,14变4则移动2根,1变7增加1根,因此你的做法不成立。
另外,4由几根组成呢?3根、4根还是5根?

TA的精华主题

TA的得分主题

发表于 2019-2-16 17:50 | 显示全部楼层
dongdonggege 发表于 2019-2-16 17:31
没那么难吧,14变4,减少1根;1变7,增加1根。总的,不是移动1根?

规则上数字至少是2跟,没有一根火柴是1的说法

给你改个能测试两位数+-*法等式是否成立的

两位数的或者多位数的+-法其实改动并不多,不过随机两位数+-*法等式,随机了半天才有个别几个能成立,不如个位数的适用

  1. Function js(eqs) As Boolean
  2.     If InStr(eqs, "=") Then
  3.         eqs = Replace(Replace(eqs, "x", "*"), "-", "+-")
  4.         L = Split(eqs, "=")(0)
  5.         R = Split(eqs, "=")(1)
  6.         If InStr(L, "+") Or InStr(L, "*") Then
  7.                 If InStr(L, "*") Then L = Val(L) * Mid(L, InStr(L, "*") + 1)
  8.                 L = Val(L) + Mid(L, InStr(L, "+") + 1)
  9.         Else
  10.                 If InStr(R, "*") Then R = Val(R) * Mid(R, InStr(R, "*") + 1)
  11.                 R = Val(R) + Mid(R, InStr(R, "+") + 1)
  12.         End If
  13.     End If
  14.     If L - R = 0 Then js = True
  15. End Function
复制代码

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-2-16 18:06 | 显示全部楼层
micch 发表于 2019-2-16 17:50
规则上数字至少是2跟,没有一根火柴是1的说法

给你改个能测试两位数+-*法等式是否成立的

老师,前面的程序是你44楼的,还是爱疯老师的?

TA的精华主题

TA的得分主题

发表于 2019-2-16 18:14 | 显示全部楼层
本帖最后由 micch 于 2019-2-16 18:17 编辑
dongdonggege 发表于 2019-2-16 18:06
老师,前面的程序是你44楼的,还是爱疯老师的?



修改原来49楼的,没注意又多了两位数的条件和等式左右两边都有运算符的问题。
再次修正一下,判断等式是否成立,等式两边可以都有+-*,数字位数不限制。

不做除法判断,没多大意思,因为除法成立的等式太少。如果判断除法需要增加除以0的可能判断

  1. Function js(eqs) As Boolean
  2.     If InStr(eqs, "=") Then
  3.         eqs = Replace(Replace(eqs, "x", "*"), "-", "+-")
  4.         L = Split(eqs, "=")(0)
  5.         R = Split(eqs, "=")(1)
  6.         If InStr(L, "*") Then L = Val(L) * Mid(L, InStr(L, "*") + 1)
  7.         If InStr(L, "+") Then L = Val(L) + Mid(L, InStr(L, "+") + 1)
  8.         If InStr(R, "*") Then R = Val(R) * Mid(R, InStr(R, "*") + 1)
  9.         If InStr(R, "+") Then R = Val(R) + Mid(R, InStr(R, "+") + 1)
  10.     End If
  11.     If L - R = 0 Then js = True
  12. End Function
复制代码

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-2-16 18:36 | 显示全部楼层
micch 发表于 2019-2-16 18:14
修改原来49楼的,没注意又多了两位数的条件和等式左右两边都有运算符的问题。
再次修正一下,判断等 ...

完整的是这样的?
  1. Sub tt()
  2.     Randomize
  3.     ss = Mid("+-x", 1 + Rnd() * 2, 1)
  4.     ss = Int(Rnd() * 10) & ss & Int(Rnd() * 10) & "=" & Int(Rnd() * 10)
  5.     [f11] = ss
  6.     [f13].Resize(9).ClearContents
  7. End Sub

  8. Sub match()
  9. Dim d, arr, ar, brr(9, 0), i%, n%, ss$, x, a, b
  10. Set d = CreateObject("Scripting.Dictionary")
  11. arr = [u2:y13]
  12.     For i = 1 To 12
  13.         d(arr(i, 1) & "+") = arr(i, 3)
  14.         d(arr(i, 1) & "-") = arr(i, 4)
  15.         d(arr(i, 1) & "c") = arr(i, 5)
  16.     Next
  17. ss = [f11]
  18. ss = Replace(Replace(ss, "x", "*"), "÷", "/")
  19.     For i = 1 To 5
  20.         x = Mid(ss, i, 1)
  21.         If x = "=" And Mid(ss, 2, 1) = "-" Then
  22.             eqs = Replace(Replace(ss, "=", "-"), "-", "=", , 1)
  23.             If Application.Evaluate(eqs) Then brr(n, 0) = eqs: n = n + 1
  24.         Else
  25.             If d(x & "c") <> "*" Then
  26.                 For Each a In Split(d(x & "c"), ",")
  27.                     eqs = Mid(Mid(" " & ss, 1, i) & Replace(ss, x, a, i, 1), 2)
  28.                     If js(eqs) Then brr(n, 0) = Replace(eqs, "*", "x"): n = n + 1
  29.                 Next
  30.             End If
  31.             If d(x & "-") <> "*" Then
  32.                 For Each a In Split(d(x & "-"), ",")
  33.                     eqs = Mid(Mid(" " & ss, 1, i) & Replace(ss, x, a, i, 1), 2)
  34.                     For k = 1 To 5
  35.                         If k <> i And d(Mid(eqs, k, 1) & "+") <> "*" Then
  36.                             For Each b In Split(d(Mid(eqs, k, 1) & "+"), ",")
  37.                                 eqs2 = Mid(Mid(" " & eqs, 1, k) & Replace(eqs, Mid(eqs, k, 1), b, k, 1), 2)
  38.                                 If js(eqs2) Then brr(n, 0) = Replace(eqs2, "*", "x"): n = n + 1
  39.                             Next b
  40.                         End If
  41.                     Next k
  42.                 Next a
  43.             End If
  44.         End If
  45.     Next i
  46. If n Then
  47.     [f13].Resize(9).ClearContents
  48.     [f13].Resize(n + 1) = brr
  49. Else
  50.     [f13].Resize(9).ClearContents
  51.     [f13] = "I can't do it!"
  52. End If
  53. End Sub

  54. Sub test()
  55. [f11] = "=index(aa:aa,z1)"
  56. End Sub

  57. Function js(eqs) As Boolean
  58.     If InStr(eqs, "=") Then
  59.         eqs = Replace(Replace(eqs, "x", "*"), "-", "+-")
  60.         L = Split(eqs, "=")(0)
  61.         R = Split(eqs, "=")(1)
  62.         If InStr(L, "+") Or InStr(L, "*") Then
  63.                 If InStr(L, "*") Then L = Val(L) * Mid(L, InStr(L, "*") + 1)
  64.                 L = Val(L) + Mid(L, InStr(L, "+") + 1)
  65.         Else
  66.                 If InStr(R, "*") Then R = Val(R) * Mid(R, InStr(R, "*") + 1)
  67.                 R = Val(R) + Mid(R, InStr(R, "+") + 1)
  68.         End If
  69.     End If
  70.     If L - R = 0 Then js = True
  71. End Function
复制代码

可是在ppt中不能运行的,可以修改一些单元格的数据为变量吗?

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-2-16 18:38 | 显示全部楼层
micch 发表于 2019-2-16 18:14
修改原来49楼的,没注意又多了两位数的条件和等式左右两边都有运算符的问题。
再次修正一下,判断等 ...

完整的是这样的?
  1. Sub tt()
  2.     Randomize
  3.     ss = Mid("+-x", 1 + Rnd() * 2, 1)
  4.     ss = Int(Rnd() * 10) & ss & Int(Rnd() * 10) & "=" & Int(Rnd() * 10)
  5.     [f11] = ss
  6.     [f13].Resize(9).ClearContents
  7. End Sub

  8. Sub match()
  9. Dim d, arr, ar, brr(9, 0), i%, n%, ss$, x, a, b
  10. Set d = CreateObject("Scripting.Dictionary")
  11. arr = [u2:y13]
  12.     For i = 1 To 12
  13.         d(arr(i, 1) & "+") = arr(i, 3)
  14.         d(arr(i, 1) & "-") = arr(i, 4)
  15.         d(arr(i, 1) & "c") = arr(i, 5)
  16.     Next
  17. ss = [f11]
  18. ss = Replace(Replace(ss, "x", "*"), "÷", "/")
  19.     For i = 1 To 5
  20.         x = Mid(ss, i, 1)
  21.         If x = "=" And Mid(ss, 2, 1) = "-" Then
  22.             eqs = Replace(Replace(ss, "=", "-"), "-", "=", , 1)
  23.             If Application.Evaluate(eqs) Then brr(n, 0) = eqs: n = n + 1
  24.         Else
  25.             If d(x & "c") <> "*" Then
  26.                 For Each a In Split(d(x & "c"), ",")
  27.                     eqs = Mid(Mid(" " & ss, 1, i) & Replace(ss, x, a, i, 1), 2)
  28.                     If js(eqs) Then brr(n, 0) = Replace(eqs, "*", "x"): n = n + 1
  29.                 Next
  30.             End If
  31.             If d(x & "-") <> "*" Then
  32.                 For Each a In Split(d(x & "-"), ",")
  33.                     eqs = Mid(Mid(" " & ss, 1, i) & Replace(ss, x, a, i, 1), 2)
  34.                     For k = 1 To 5
  35.                         If k <> i And d(Mid(eqs, k, 1) & "+") <> "*" Then
  36.                             For Each b In Split(d(Mid(eqs, k, 1) & "+"), ",")
  37.                                 eqs2 = Mid(Mid(" " & eqs, 1, k) & Replace(eqs, Mid(eqs, k, 1), b, k, 1), 2)
  38.                                 If js(eqs2) Then brr(n, 0) = Replace(eqs2, "*", "x"): n = n + 1
  39.                             Next b
  40.                         End If
  41.                     Next k
  42.                 Next a
  43.             End If
  44.         End If
  45.     Next i
  46. If n Then
  47.     [f13].Resize(9).ClearContents
  48.     [f13].Resize(n + 1) = brr
  49. Else
  50.     [f13].Resize(9).ClearContents
  51.     [f13] = "I can't do it!"
  52. End If
  53. End Sub

  54. Sub test()
  55. [f11] = "=index(aa:aa,z1)"
  56. End Sub

  57. Function js(eqs) As Boolean
  58.     If InStr(eqs, "=") Then
  59.         eqs = Replace(Replace(eqs, "x", "*"), "-", "+-")
  60.         L = Split(eqs, "=")(0)
  61.         R = Split(eqs, "=")(1)
  62.         If InStr(L, "+") Or InStr(L, "*") Then
  63.                 If InStr(L, "*") Then L = Val(L) * Mid(L, InStr(L, "*") + 1)
  64.                 L = Val(L) + Mid(L, InStr(L, "+") + 1)
  65.         Else
  66.                 If InStr(R, "*") Then R = Val(R) * Mid(R, InStr(R, "*") + 1)
  67.                 R = Val(R) + Mid(R, InStr(R, "+") + 1)
  68.         End If
  69.     End If
  70.     If L - R = 0 Then js = True
  71. End Function
复制代码

可是在ppt中不能运行的,可以修改一些单元格的数据为变量吗?

TA的精华主题

TA的得分主题

发表于 2019-2-16 18:56 | 显示全部楼层
本帖最后由 micch 于 2019-2-16 19:58 编辑

还是给你改改吧,不能判断等式两边都有减号的等式是否成立,增加运算符号,需要改几处地方,暂时懒得弄。
  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.     arr = [u2:y13] '存放火柴变化的规则
  13.         For i = 1 To 12
  14.             d(arr(i, 1) & "+") = arr(i, 3)
  15.             d(arr(i, 1) & "-") = arr(i, 4)
  16.             d(arr(i, 1) & "c") = arr(i, 5)
  17.         Next
  18.     ss = [f11]
  19.     ss = Replace(ss, "x", "*")
  20.     For i = 1 To Len(ss)
  21.         x = Mid(ss, i, 1)
  22.         If x = "=" And InStr(ss, "-") Then '等号与减号互换后成立判断
  23.             eqs = Replace(Replace(ss, "=", "-"), "-", "=", , 1)
  24.             If js(eqs) Then brr(n, 0) = eqs: n = n + 1
  25.         Else
  26.             If d(x & "c") <> "*" Then '原数字内移动一根后成立判断
  27.                 For Each a In Split(d(x & "c"), ",")
  28.                     eqs = Mid(Mid(" " & ss, 1, i) & Replace(ss, x, a, i, 1), 2)
  29.                     If js(eqs) Then brr(n, 0) = Replace(eqs, "*", "x"): n = n + 1
  30.                 Next
  31.             End If
  32.             If d(x & "-") <> "*" Then '一处减少另一处增加一根后成立判断
  33.                 For Each a In Split(d(x & "-"), ",")
  34.                     eqs = Mid(Mid(" " & ss, 1, i) & Replace(ss, x, a, i, 1), 2)
  35.                     For k = 1 To Len(eqs)
  36.                         If k <> i And d(Mid(eqs, k, 1) & "+") <> "*" Then
  37.                             For Each b In Split(d(Mid(eqs, k, 1) & "+"), ",")
  38.                                 eqs2 = Mid(Mid(" " & eqs, 1, k) & Replace(eqs, Mid(eqs, k, 1), b, k, 1), 2)
  39.                                 If js(eqs2) Then brr(n, 0) = Replace(eqs2, "*", "x"): n = n + 1
  40.                             Next b
  41.                         End If
  42.                     Next k
  43.                 Next a
  44.             End If
  45.         End If
  46.     Next i
  47.     [f13].Resize(9).ClearContents
  48.     If n Then
  49.         [f13].Resize(n + 1) = brr
  50.     Else
  51.         [f13] = "I can't do it!"
  52.     End If
  53. End Sub
  54. Function js(eqs) As Boolean
  55.     If InStr(eqs, "=") Then
  56.         eqs1 = eqs
  57.         eqs = Replace(Replace(eqs, "x", "*"), "-", "+-")
  58.         L = Split(eqs, "=")(0)
  59.         R = Split(eqs, "=")(1)
  60.         If InStr(L, "*") Then L = Val(L) * Mid(L, InStr(L, "*") + 1)
  61.         If InStr(R, "*") Then R = Val(R) * Mid(R, InStr(R, "*") + 1)
  62.         If InStr(L, "+") Then L = Val(L) + Mid(L, InStr(L, "+") + 1)
  63.         If InStr(R, "+") Then R = Val(R) + Mid(R, InStr(R, "+") + 1)
  64.         If L - R = 0 Then js = True
  65.         eqs = eqs1
  66.     End If
  67. End Function
复制代码

TA的精华主题

TA的得分主题

发表于 2019-2-16 19:00 | 显示全部楼层
本帖最后由 micch 于 2019-2-16 20:00 编辑

完整的代码中随机生成代码那个是测试用的,可以不要删除,就是tt那个过程。如果保留,第4行那里的3个两位数可以自行设定随机的范围。

match是判断等式是否成立,增加了位数的判断,只是在原来基础上改了改,没认真去考虑遗漏条件的问题。判断等式成立改为自定义函数判断,因为自定义函数没增加多个减号运算的判断,所以暂时还不能判断*-*=*-*之类的判断。


PPT怎么用我完全没有概念,不懂。我也不过是初学,PPT代码写哪我都不知道,没法测试



TA的精华主题

TA的得分主题

发表于 2019-2-16 19:05 | 显示全部楼层
dongdonggege 发表于 2019-2-16 18:38
完整的是这样的?

可是在ppt中不能运行的,可以修改一些单元格的数据为变量吗?

77楼这个代码,是原来的吧。

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

20行那里改了,原来是个位数运算,所以等式长度是5,改为len来判断循环次数。k循环也是要改为等式长度,因为不是固定长度。
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关闭

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

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

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

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

Powered by Discuz! X3.4

© 1999-2020 Wooffice Inc.

   

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

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

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