完整的是这样的?
- Sub tt()
- Randomize
- ss = Mid("+-x", 1 + Rnd() * 2, 1)
- ss = Int(Rnd() * 10) & ss & Int(Rnd() * 10) & "=" & Int(Rnd() * 10)
- [f11] = ss
- [f13].Resize(9).ClearContents
- End Sub
- Sub match()
- Dim d, arr, ar, brr(9, 0), i%, n%, ss$, x, a, b
- Set d = CreateObject("Scripting.Dictionary")
- arr = [u2:y13]
- 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 = [f11]
- ss = Replace(Replace(ss, "x", "*"), "÷", "/")
- For i = 1 To 5
- x = Mid(ss, i, 1)
- If x = "=" And Mid(ss, 2, 1) = "-" Then
- eqs = Replace(Replace(ss, "=", "-"), "-", "=", , 1)
- If Application.Evaluate(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 5
- 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
- If n Then
- [f13].Resize(9).ClearContents
- [f13].Resize(n + 1) = brr
- Else
- [f13].Resize(9).ClearContents
- [f13] = "I can't do it!"
- End If
- End Sub
- Sub test()
- [f11] = "=index(aa:aa,z1)"
- End Sub
- Function js(eqs) As Boolean
- If InStr(eqs, "=") Then
- eqs = Replace(Replace(eqs, "x", "*"), "-", "+-")
- L = Split(eqs, "=")(0)
- R = Split(eqs, "=")(1)
- If InStr(L, "+") Or InStr(L, "*") Then
- If InStr(L, "*") Then L = Val(L) * Mid(L, InStr(L, "*") + 1)
- L = Val(L) + Mid(L, InStr(L, "+") + 1)
- Else
- If InStr(R, "*") Then R = Val(R) * Mid(R, InStr(R, "*") + 1)
- R = Val(R) + Mid(R, InStr(R, "+") + 1)
- End If
- End If
- If L - R = 0 Then js = True
- End Function
复制代码
可是在ppt中不能运行的,可以修改一些单元格的数据为变量吗? |