世界最难的数组怎么赋值

micch

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

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

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

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

dongdonggege

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

老师，你的附件能上传吗？

dongdonggege

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

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

micch

dongdonggege 发表于 2019-2-13 19:13
另外，excel支持Application.Evaluate，ppt不支持，请问能否修改这句话。

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

2019-2-13 19:25 上传

点击文件名下载附件

不用这个方式判断等式是否成立，那就只能直接把等式分成左右两部分，判断left=right，用mid就可以

但是判断等式成立，就单独写一小段代码，懒得弄了，那不如换个方式实现了，用数组得到左边可能的所有计算结果，然后和右边的数组比对，那是另一个思路了

爱疯

huocai3.rar (22.87 KB, 下载次数: 4)

2019-2-13 19:25 上传

点击文件名下载附件

没偷懒的判断和循环，很泄气。。。。。
要试下不知还有没有错。





'火柴
Sub hc()
    Dim A, i, j, k, c, x, y, z, s, p, q
    'A列是变化前，B列变化后，C列变化类型
    '后半部分（15到28）是前半部分（1到14）的逆操作
    A = Range("a1").CurrentRegion
    x = InputBox("移动一根火柴，使其成立", "问题", "6+4=4")
    s = x & vbLf & "可变成" & vbLf & vbLf

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

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

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

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

                    Else

                        '3-2 因变，和另一个字符同时变化
                        '3-2-1 因变_字符1，总是需要变的，所以提取出来
                        y = x
                        Mid(y, i, Len(A(j, 2))) = A(j, 2)
                        '3-2-2 因变_字符2
                        p = 1  '扫过位置
                        If A(j, 3) = "+" Then
                            '则另一个字符必是可减，比如 8变6
                            For k = 1 To UBound(A)
                                If A(k, 3) = "-" Then
                                    q = InStr(p, y, A(k, 1))    '字符2的当前位置
                                    If q > 0 Then
                                        p = q
'                                        Debug.Print y, A(k, 1), "扫完" & p, "当前" & q
                                        z = y
                                        Mid(z, q, Len(A(k, 1))) = A(k, 2)
                                        If f(z) Then If InStr(s, z) = 0 Then s = s & vbLf & z
                                    End If
                                End If
                            Next k
                        ElseIf A(j, 3) = "-" Then
                            '则另一个字符必是可加，比如 6变8
                            For k = 1 To UBound(A)
                                If A(k, 3) = "+" Then
                                    q = InStr(p, y, A(k, 1))
                                    If q > 0 Then
                                        p = q
                                        z = y
                                        Mid(z, q, Len(A(k, 1))) = A(k, 2)
                                        If f(z) Then If InStr(s, z) = 0 Then s = s & vbLf & z
                                    End If
                                End If
                            Next k
                        End If

                    End If

                End If
            Next j

        End If
    Next i

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


'判断
Function f(s) As Boolean
    Dim arr, l, r
    If InStr(s, "=") Then
        arr = VBA.Split(s, "=")
        l = Application.Evaluate(arr(0))
        r = Application.Evaluate(arr(1))
        If VBA.IsNumeric(l) And VBA.IsNumeric(r) Then
            If l = r Then f = True
        End If
    End If
End Function

dongdonggege

爱疯 发表于 2019-2-13 19:28
没偷懒的判断和循环，很泄气。。。。。
要试下不知还有没有错。

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

1. Option Explicit
   
2. 
   
3. '6+4=4
   
4. '答案1，0+4=4
   
5. '答案2，8-4=4
   
6. 
   
7. '火柴
   
8. Sub hc()
   
9.     Dim i, j, k, c, x, y, z, s, p, q
   
10.     'A列是变化前，B列变化后，C列变化类型
    
11.     '后半部分（15到28）是前半部分（1到14）的逆操作
    
12.     'A = Range("a1").CurrentRegion
    
13.     Dim A() As String
    
14.     ReDim A(1 To 28, 1 To 3) As String
    
15.     A(1, 1) = 0: A(1, 2) = 6: A(1, 3) = "自变": A(2, 1) = 0: A(2, 2) = 8: A(2, 3) = "自变"
    
16.     A(3, 1) = 0: A(3, 2) = 9: A(3, 3) = "自变": A(4, 1) = 1: A(4, 2) = 7: A(4, 3) = "自变"
    
17.     A(5, 1) = 1: A(5, 2) = "+": A(5, 3) = "+": A(6, 1) = 3: A(6, 2) = 9: A(6, 3) = "+"
    
18.     A(7, 1) = 5: A(7, 2) = 6: A(7, 3) = "+": A(8, 1) = 5: A(8, 2) = 9: A(8, 3) = "+"
    
19.     A(9, 1) = 6: A(9, 2) = 8: A(9, 3) = "+": A(10, 1) = 6: A(10, 2) = 9: A(10, 3) = "+"
    
20.     A(11, 1) = 8: A(11, 2) = 9: A(11, 3) = "+": A(12, 1) = 11: A(12, 2) = "+": A(12, 3) = "自变"
    
21.     A(13, 1) = "-": A(13, 2) = "+": A(13, 3) = "+": A(14, 1) = "-": A(14, 2) = "+": A(14, 3) = "="
    
22.     A(15, 1) = 6: A(15, 2) = 0: A(15, 3) = "自变": A(16, 1) = 8: A(16, 2) = 0: A(16, 3) = "自变"
    
23.     A(17, 1) = 9: A(17, 2) = 0: A(17, 3) = "自变": A(18, 1) = 7: A(18, 2) = 1: A(18, 3) = "自变"
    
24.     A(19, 1) = "+": A(19, 2) = 1: A(19, 3) = "-": A(20, 1) = 9: A(20, 2) = 3: A(20, 3) = "-"
    
25.     A(21, 1) = 6: A(21, 2) = 5: A(21, 3) = "-": A(22, 1) = 9: A(22, 2) = 5: A(22, 3) = "-"
    
26.     A(23, 1) = 8: A(23, 2) = 6: A(23, 3) = "-": A(24, 1) = 9: A(24, 2) = 6: A(24, 3) = "-"
    
27.     A(25, 1) = 9: A(25, 2) = 8: A(25, 3) = "-": A(26, 1) = "+": A(26, 2) = 11: A(26, 3) = "自变"
    
28.     A(27, 1) = "+": A(27, 2) = "-": A(27, 3) = "-": A(28, 1) = "=": A(28, 2) = "-": A(28, 3) = "-"
    
29.     x = InputBox("移动一根火柴，使其成立", "问题", "6+4=4")
    
30.     s = x & vbLf & "可变成" & vbLf & vbLf
    
31. 
    
32.     '1. 遍历所有字符
    
33.     For i = 1 To Len(x)
    
34.         c = Mid(x, i, 1)    '比如，返回"6"
    
35.         If InStr("011356789-+=", c) Then
    
36. 
    
37.             '2. 遍历所有结果
    
38.             For j = 1 To UBound(A)
    
39.                 If c = CStr(A(j, 1)) Then
    
40. 
    
41.                     '3. 按变化类型，选不同规则
    
42.                     If A(j, 3) = "自变" Then
    
43. 
    
44.                         '3-1 自变，指只有自身一个字符变化。比如 6变0
    
45.                         y = x    '备份
    
46.                         Mid(y, i, Len(A(j, 2))) = A(j, 2)    'Mid(字符串, 替换位置, 替换长度) = 用于替换的子串
    
47.                         If f(y) Then If InStr(s, y) = 0 Then s = s & vbLf & y
    
48. 
    
49.                     Else
    
50. 
    
51.                         '3-2 因变，和另一个字符同时变化
    
52.                         '3-2-1 因变_字符1，总是需要变的，所以提取出来
    
53.                         y = x
    
54.                         Mid(y, i, Len(A(j, 2))) = A(j, 2)
    
55.                         '3-2-2 因变_字符2
    
56.                         p = 1  '扫过位置
    
57.                         If A(j, 3) = "+" Then
    
58.                             '则另一个字符必是可减，比如 8变6
    
59.                             For k = 1 To UBound(A)
    
60.                                 If A(k, 3) = "-" Then
    
61.                                     q = InStr(p, y, A(k, 1))    '字符2的当前位置
    
62.                                     If q > 0 Then
    
63.                                         p = q
    
64. '                                        Debug.Print y, A(k, 1), "扫完" & p, "当前" & q
    
65.                                         z = y
    
66.                                         Mid(z, q, Len(A(k, 1))) = A(k, 2)
    
67.                                         If f(z) Then If InStr(s, z) = 0 Then s = s & vbLf & z
    
68.                                     End If
    
69.                                 End If
    
70.                             Next k
    
71.                         ElseIf A(j, 3) = "-" Then
    
72.                             '则另一个字符必是可加，比如 6变8
    
73.                             For k = 1 To UBound(A)
    
74.                                 If A(k, 3) = "+" Then
    
75.                                     q = InStr(p, y, A(k, 1))
    
76.                                     If q > 0 Then
    
77.                                         p = q
    
78.                                         z = y
    
79.                                         Mid(z, q, Len(A(k, 1))) = A(k, 2)
    
80.                                         If f(z) Then If InStr(s, z) = 0 Then s = s & vbLf & z
    
81.                                     End If
    
82.                                 End If
    
83.                             Next k
    
84.                         End If
    
85. 
    
86.                     End If
    
87. 
    
88.                 End If
    
89.             Next j
    
90. 
    
91.         End If
    
92.     Next i
    
93. 
    
94.     MsgBox IIf(Len(s) = 12, "快去请如来佛祖!", s), , "答案"
    
95. End Sub
    
96. 
    
97. '判断
    
98. Function f(s) As Boolean
    
99.     Dim arr, l, r
    
100.     If InStr(s, "=") Then
     
101.         arr = VBA.Split(s, "=")
     
102.         l = Application.Evaluate(arr(0))
     
103.         r = Application.Evaluate(arr(1))
     
104.         If VBA.IsNumeric(l) And VBA.IsNumeric(r) Then
     
105.             If l = r Then f = True
     
106.         End If
     
107.     End If
     
108. End Function

复制代码

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

micch

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

复制代码

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

dongdonggege

micch 发表于 2019-2-13 20:32
写个笨笨的计算代码，仅限于个位数计算。判断等号两边是否相等，等号可以是第二，第四位，但必须有等 ...

这个函数没看懂，是连接哪个程序的？

micch

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

dongdonggege

micch 发表于 2019-2-13 20:32
写个笨笨的计算代码，仅限于个位数计算。判断等号两边是否相等，等号可以是第二，第四位，但必须有等 ...

是match程序吧？