世界最难的数组怎么赋值

dongdonggege

micch 发表于 2019-2-16 17:13
14+1=11  怎么可能变成4+7=11  14变4那不是少了两根火柴？？7那才多了一根，还有一根去哪了？

没那么难吧，14变4，减少1根；1变7，增加1根。总的，不是移动1根？

乐乐2006201505

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根？

micch

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

复制代码

dongdonggege

micch 发表于 2019-2-16 17:50
规则上数字至少是2跟，没有一根火柴是1的说法

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

老师，前面的程序是你44楼的，还是爱疯老师的？

micch

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

复制代码

dongdonggege

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. 
   
9. Sub match()
   
10. Dim d, arr, ar, brr(9, 0), i%, 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(Replace(ss, "x", "*"), "÷", "/")
    
20.     For i = 1 To 5
    
21.         x = Mid(ss, i, 1)
    
22.         If x = "=" And Mid(ss, 2, 1) = "-" Then
    
23.             eqs = Replace(Replace(ss, "=", "-"), "-", "=", , 1)
    
24.             If Application.Evaluate(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 5
    
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. If n Then
    
48.     [f13].Resize(9).ClearContents
    
49.     [f13].Resize(n + 1) = brr
    
50. Else
    
51.     [f13].Resize(9).ClearContents
    
52.     [f13] = "I can't do it!"
    
53. End If
    
54. End Sub
    
55. 
    
56. Sub test()
    
57. [f11] = "=index(aa:aa,z1)"
    
58. End Sub
    
59. 
    
60. Function js(eqs) As Boolean
    
61.     If InStr(eqs, "=") Then
    
62.         eqs = Replace(Replace(eqs, "x", "*"), "-", "+-")
    
63.         L = Split(eqs, "=")(0)
    
64.         R = Split(eqs, "=")(1)
    
65.         If InStr(L, "+") Or InStr(L, "*") Then
    
66.                 If InStr(L, "*") Then L = Val(L) * Mid(L, InStr(L, "*") + 1)
    
67.                 L = Val(L) + Mid(L, InStr(L, "+") + 1)
    
68.         Else
    
69.                 If InStr(R, "*") Then R = Val(R) * Mid(R, InStr(R, "*") + 1)
    
70.                 R = Val(R) + Mid(R, InStr(R, "+") + 1)
    
71.         End If
    
72.     End If
    
73.     If L - R = 0 Then js = True
    
74. End Function

复制代码

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

dongdonggege

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. 
   
9. Sub match()
   
10. Dim d, arr, ar, brr(9, 0), i%, 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(Replace(ss, "x", "*"), "÷", "/")
    
20.     For i = 1 To 5
    
21.         x = Mid(ss, i, 1)
    
22.         If x = "=" And Mid(ss, 2, 1) = "-" Then
    
23.             eqs = Replace(Replace(ss, "=", "-"), "-", "=", , 1)
    
24.             If Application.Evaluate(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 5
    
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. If n Then
    
48.     [f13].Resize(9).ClearContents
    
49.     [f13].Resize(n + 1) = brr
    
50. Else
    
51.     [f13].Resize(9).ClearContents
    
52.     [f13] = "I can't do it!"
    
53. End If
    
54. End Sub
    
55. 
    
56. Sub test()
    
57. [f11] = "=index(aa:aa,z1)"
    
58. End Sub
    
59. 
    
60. Function js(eqs) As Boolean
    
61.     If InStr(eqs, "=") Then
    
62.         eqs = Replace(Replace(eqs, "x", "*"), "-", "+-")
    
63.         L = Split(eqs, "=")(0)
    
64.         R = Split(eqs, "=")(1)
    
65.         If InStr(L, "+") Or InStr(L, "*") Then
    
66.                 If InStr(L, "*") Then L = Val(L) * Mid(L, InStr(L, "*") + 1)
    
67.                 L = Val(L) + Mid(L, InStr(L, "+") + 1)
    
68.         Else
    
69.                 If InStr(R, "*") Then R = Val(R) * Mid(R, InStr(R, "*") + 1)
    
70.                 R = Val(R) + Mid(R, InStr(R, "+") + 1)
    
71.         End If
    
72.     End If
    
73.     If L - R = 0 Then js = True
    
74. End Function

复制代码

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

micch

还是给你改改吧，不能判断等式两边都有减号的等式是否成立，增加运算符号，需要改几处地方，暂时懒得弄。

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

复制代码

micch

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

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


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

micch

dongdonggege 发表于 2019-2-16 18:38
完整的是这样的？

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

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

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

20行那里改了，原来是个位数运算，所以等式长度是5，改为len来判断循环次数。k循环也是要改为等式长度，因为不是固定长度。