世界最难的数组怎么赋值

爱疯

1.rar (16.05 KB, 下载次数: 2)

2019-2-13 09:36 上传

点击文件名下载附件

网上好像很多是要求移动一根，所以就只做移动一根的情况。
没多试，不知可以吗




Sub test()
    Dim A, x, y, i, j, n
    A = Range("a1").CurrentRegion
    x = InputBox("移动一根火柴，使其成立", "提示", "6+4=4")
'    x = InputBox("移动一根火柴，使其成立", "提示", "6+4=4")
    y = x

    For i = 1 To Len(x)
        n = Mid(x, i, 1)
        If IsNumeric(n) Then n = CInt(n)
        For j = 1 To UBound(A)
            If n = A(j, 1) Then
                Mid(y, i, Len(A(j, 2))) = A(j, 2)
                If Application.Evaluate(y) Then MsgBox y: End
                y = x
            End If
        Next j
    Next i
    MsgBox "快去请如来佛祖!"
End Sub

爱疯

6+4=4
答案1，5+4=9
答案2，0+4=4
答案3，8-4=4


我的方法不对，再想下

dongdonggege

爱疯 发表于 2019-2-13 09:38
网上好像很多是要求移动一根，所以就只做移动一根的情况。
没多试，不知可以吗

老师，你这只看移动的，好像行，那还有一个数增加，另一个数减少的呢？没考虑上。

dongdonggege

爱疯 发表于 2019-2-13 09:38
网上好像很多是要求移动一根，所以就只做移动一根的情况。
没多试，不知可以吗

另外两位数的好像不行。

micch

爱疯 发表于 2019-2-13 10:16
6+4=4
答案1，5+4=9
答案2，0+4=4

答案1，比原来多了一根火柴。答案23好像是对的。

先把游戏规则定好。是移动一根火柴，然后等式成立；还是3种情况，移动一根，或者增加一根，或者减少一根。还有就是数字可不可以两位数，两位数就复杂指数倍了。

加号减号等号也就罢了，除号和乘号算几根火柴，不知道怎么算啊，乘号是斜的，那移动一根就后是除？还是错误？

dongdonggege

micch 发表于 2019-2-13 10:58
答案1，比原来多了一根火柴。答案23好像是对的。

先把游戏规则定好。是移动一根火柴，然后等式成立； ...

建议规则：（暂时所有数均为1位数）
1、按数位加减乘除，等式成立。
2、各数字变换（增加、减少、移动）方法见1楼。
3、各数字均按七段码8的形式组成。
4、运算符号，乘除号不能增加、减少、移动，加号、减号变换如1楼。
建议方法：
1、先把数组建立起来，好循环。
2、建立专有函数，方便循环，判断。
3、按照数位或顺序再去循环、判断，计算。

micch

不考虑两位数，+号就不能变11了，+变11等号左边不是成了4位数了。

不过+能不能变等于？1+1=1  变1=1=1

dongdonggege

micch 发表于 2019-2-13 11:28
不考虑两位数，+号就不能变11了，+变11等号左边不是成了4位数了。

不过+能不能变等于？1+1=1  变1=1=1

那你看规则怎么修改？

aman1516

dongdonggege 发表于 2019-2-13 12:59
那你看规则怎么修改？

个人理解，1应该是2根火柴组成吧，所以+移动一根只能变成1，而不是11（标准4根组成），又如，7应该是3根火柴...变化不应以“相似”成立，
+ 是2根火柴，- 是1 根，＝ 是2根，×＝ 是2根，／是1根，及各数字火柴根数应统一

micch

思路不对，就费功夫，用循环做了一个，写的真长。结果除法的时候出现除0的错误，懒得改了，只做+-*的等式。列了一个增减变化的表，然后加入字典，循环判断；

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

复制代码