谢谢,受你的启发,一样用Evaluate来盘算是不是算式就好了.
其实我的最终意图是像下面一样,放在加载宏里面,按快捷键后显示当前选中单元格的英文翻译和算式计算.
最终就类似这样写,应该能抓个大概了
Sub fy()
MsgBox "英文翻译: " & Chr(13) & 有道翻译(Selection) & Chr(13) & Chr(13) & "包含算式结果: " & 计算(Selection)
End Sub
Function 计算(txt) As String '计算单元格内算术公式
If txt.Count > 1 Then
For Each T In txt
stxt = stxt & "=" & T
Next
End If
txt = stxt
txt = Application.Substitute(txt, "[", "(")
txt = Application.Substitute(txt, "]", ")")
txt = Application.Substitute(txt, "{", "(")
txt = Application.Substitute(txt, "}", ")")
txt = Application.Substitute(txt, "X", "*")
txt = Application.Substitute(txt, "×", "*")
txt = Application.Substitute(txt, "÷", "/")
txt = Application.Substitute(txt, ",", "=")
txt = Application.Substitute(txt, ",", "=")
txt = Application.Substitute(txt, "。", "=")
txt = Application.Substitute(txt, ":", "=")
On Error Resume Next
a = 正则提取(txt, "[^0-9,+,*,/,=,(,),-]")
If Not a Like "*=*" Then Exit Function
arr = Split(a, "=")
For Each aa In arr
'MsgBox aa
If aa Like "*#[+,*,/,-]#*" Then
Err.Clear
Eva = Evaluate(aa) * 1
If Err.Number > 0 Then Eva = "错误或不是算式"
If Eva <> aa * 1 Then 计算 = 计算 & Chr(10) & aa & " = " & Eva
End If
Next aa
End Function
Function 正则提取(原内容, 正则表达式) '原内容,正则表达式
If Len(原内容) < 1 Then Exit Function
Dim reg As Object: Set reg = CreateObject("vbscript.regexp")
With reg
.Global = True
.Pattern = 正则表达式
正则提取 = .Replace(原内容, "")
End With
Set reg = Nothing
End Function
Function 有道翻译(txt)
Dim xml
Dim url$, EngSentence$, s1 As String, str%, sed%, ss$
aa = Timer
If txt.Count > 1 Then
For Each T In txt
stxt = stxt & " " & T
Next
End If
Set xml = CreateObject("MSXML2.ServerXMLHTTP.6.0")
url = "http://fanyi.youdao.com/translate?&i=" & stxt & "&doctype=xml&version"
With xml
.Open "GET", url, False
DoEvents
.send
DoEvents
Sleep 300
ss = .responseText
End With
str = InStrRev(ss, "<![CDATA[")
sed = InStrRev(ss, "]]>")
有道翻译 = Mid(ss, str + 9, sed - (str + 9))
End Function |