改出来了,brr(n,0),空值怎么让它不打印出来呢?
- Sub tt()
- Randomize '随机生成等式并测试成立与否
- ss = Mid("+-x", 1 + Rnd() * 2, 1)
- ss = Int(Rnd() * 66) & ss & Int(Rnd() * 66) & "=" & Int(Rnd() * 66)
- [f11] = ss '存放等式的位置,自行更改,上一行随机的数字自行修改
- [f13].Resize(9).ClearContents
- match
- End Sub
- Sub match()
- Dim d, arr, ar, brr(9, 0), i%, k%, n%, ss$, x, a, b
- Set d = CreateObject("Scripting.Dictionary")
- ReDim arr(1 To 12, 1 To 5) As String
- Set d = CreateObject("Scripting.Dictionary")
- arr(1, 1) = 0: arr(1, 2) = 6: arr(1, 3) = 8: arr(1, 4) = "*": arr(1, 5) = "6,9"
- arr(2, 1) = 1: arr(2, 2) = 2: arr(2, 3) = 7: arr(2, 4) = "*": arr(2, 5) = "*"
- arr(3, 1) = 2: arr(3, 2) = 5: arr(3, 3) = "*": arr(3, 4) = "*": arr(3, 5) = "3"
- arr(4, 1) = 3: arr(4, 2) = 5: arr(4, 3) = 9: arr(4, 4) = "*": arr(4, 5) = "2,5"
- arr(5, 1) = 4: arr(5, 2) = 4: arr(5, 3) = "*": arr(5, 4) = "*": arr(5, 5) = "*"
- arr(6, 1) = 5: arr(6, 2) = 5: arr(6, 3) = "6,9": arr(6, 4) = "*": arr(6, 5) = "3"
- arr(7, 1) = 6: arr(7, 2) = 6: arr(7, 3) = 8: arr(7, 4) = 5: arr(7, 5) = "0,9"
- arr(8, 1) = 7: arr(8, 2) = 3: arr(8, 3) = "*": arr(8, 4) = 1: arr(8, 5) = "*"
- arr(9, 1) = 8: arr(9, 2) = 7: arr(8, 3) = "*": arr(9, 4) = "0,6,9": arr(9, 5) = "*"
- arr(10, 1) = 9: arr(10, 2) = 6: arr(10, 3) = 8: arr(10, 4) = "3,5": arr(10, 5) = "0,6"
- arr(11, 1) = "+": arr(11, 2) = 2: arr(11, 3) = "*": arr(11, 4) = "-": arr(11, 5) = "*"
- arr(12, 1) = "-": arr(12, 2) = 3: arr(12, 3) = "+": arr(12, 4) = "*": arr(12, 5) = "*"
- For i = 1 To 12
- d(arr(i, 1) & "+") = arr(i, 3)
- d(arr(i, 1) & "-") = arr(i, 4)
- d(arr(i, 1) & "c") = arr(i, 5)
- Next
- ss = "9+5=9"
- ss = Replace(ss, "x", "*")
- For i = 1 To Len(ss)
- x = Mid(ss, i, 1)
- If x = "=" And InStr(ss, "-") Then '等号与减号互换后成立判断
- eqs = Replace(Replace(ss, "=", "-"), "-", "=", , 1)
- If js(eqs) Then brr(n, 0) = eqs: n = n + 1
- Else
- If d(x & "c") <> "*" Then '原数字内移动一根后成立判断
- For Each a In Split(d(x & "c"), ",")
- eqs = Mid(Mid(" " & ss, 1, i) & Replace(ss, x, a, i, 1), 2)
- If js(eqs) Then brr(n, 0) = Replace(eqs, "*", "x"): n = n + 1
- Next
- End If
- If d(x & "-") <> "*" Then '一处减少另一处增加一根后成立判断
- For Each a In Split(d(x & "-"), ",")
- eqs = Mid(Mid(" " & ss, 1, i) & Replace(ss, x, a, i, 1), 2)
- For k = 1 To Len(eqs)
- If k <> i And d(Mid(eqs, k, 1) & "+") <> "*" Then
- For Each b In Split(d(Mid(eqs, k, 1) & "+"), ",")
- eqs2 = Mid(Mid(" " & eqs, 1, k) & Replace(eqs, Mid(eqs, k, 1), b, k, 1), 2)
- If js(eqs2) Then brr(n, 0) = Replace(eqs2, "*", "x"): n = n + 1
- Next b
- End If
- Next k
- Next a
- End If
- End If
- Next i
- '[f13].Resize(9).ClearContents
- If n Then
- '[f13].Resize(n + 1) = brr
- For n = 0 To 9
- Debug.Print brr(n, 0) '空值怎么不打印出来呢
- Next
- Else
- '[f13] = "I can't do it!"
- For n = 0 To 9
- Debug.Print brr(n, 0) '空值怎么不打印出来呢
- Next
- End If
- End Sub
- Function js(eqs) As Boolean
- If InStr(eqs, "=") Then
- eqs1 = eqs
- eqs = Replace(Replace(eqs, "x", "*"), "-", "+-")
- L = Split(eqs, "=")(0)
- R = Split(eqs, "=")(1)
- If InStr(L, "*") Then L = Val(L) * Mid(L, InStr(L, "*") + 1)
- If InStr(R, "*") Then R = Val(R) * Mid(R, InStr(R, "*") + 1)
- If InStr(L, "+") Then L = Val(L) + Mid(L, InStr(L, "+") + 1)
- If InStr(R, "+") Then R = Val(R) + Mid(R, InStr(R, "+") + 1)
- If L - R = 0 Then js = True
- eqs = eqs1
- End If
- End Function
复制代码
这样的word,excle,ppt就通用了。老师看看。 |