网抓，有道翻译

bailanhong

O(∩_∩)O谢谢

缔造者

浮华、缠绕指尖 发表于 2015-3-30 23:25
本来给了你函数又不要，唉，怪谁呢。

求英汉互译函数，谢谢！

浮华、缠绕指尖

缔造者 发表于 2015-3-31 09:11
求英汉互译函数，谢谢！

这是一个自定义函数，如果不清楚怎么用，具体可以查询百度用法

缔造者

浮华、缠绕指尖 发表于 2015-3-31 09:24
这是一个自定义函数，如果不清楚怎么用，具体可以查询百度用法

貌似是封装好的

renahu

suwenkai 发表于 2015-3-29 22:23
Sub 按钮1_Click()
    Dim pd As String
    Dim html As Object

老师，有道翻译里面那个中文转码函数找到了吗？这个转码很奇怪，比如中文“爱”，居然是：%C3%A7%C2%88%C2%B1%0A ，最后的%0A 表示换行，前面的是什么格式？用各种转码都不行

renahu

浮华、缠绕指尖 发表于 2015-3-30 23:25
本来给了你函数又不要，唉，怪谁呢。

老师，有道翻译里面那个中文转码函数是什么呀？这个转码很奇怪，比如中文“爱”，居然是：%C3%A7%C2%88%C2%B1%0A ，最后的%0A 表示换行，前面的是什么格式？用各种转码都不行

ammyc

好好学习天天向上

学不完用不尽

这是renahu大神的代码，完美！
有道翻译中英互译.zip (18.67 KB, 下载次数: 57)

2018-1-5 20:00 上传

点击文件名下载附件

1. Sub 按钮2_Click()                                                    '对suwenkai老师的代码进行了补充，感谢 much 的帮助
   
2. Dim pd$, exp$, i%, j%
   
3. Set js = CreateObject("scriptcontrol")
   
4. js.Language = "jscript"
   
5. For i = 2 To Range("A" & 1).End(xlDown).Row
   
6.     exp = ""
   
7.     pd = "type=AUTO"
   
8.     pd = pd & "&i=" & Replace(Replace(Replace(encodeURI(Cells(i, 1).Value), "%", "%C2%"), "%C2%E", "%C3%A"), "%C2%20", " ")
   
9.     pd = pd & "&doctype=json"
   
10.     URL = "http://fanyi.youdao.com/translate?smartresult=dict&smartresult=rule&smartresult=ugc&sessionFrom=null"
    
11.     With CreateObject("msxml2.xmlhttp")
    
12.         .Open "POST", URL, False
    
13.         .setrequestHeader "Host", "fanyi.youdao.com"
    
14.         .setrequestHeader "Connection", "keep-alive"
    
15.         .setrequestHeader "Content-Length", "137"
    
16.         .setrequestHeader "Accept", "application/json, text/javascript, */*; q=0.01"
    
17.         .setrequestHeader "Origin", "http://fanyi.youdao.com"
    
18.         .setrequestHeader "X-Requested-With", "XMLHttpRequest"
    
19.         .setrequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/41.0.2272.101 Safari/537.36"
    
20.         .setrequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8"
    
21.         .setrequestHeader "Referer", "http://fanyi.youdao.com/"
    
22.         .setrequestHeader "Accept-Encoding", "gzip, deflate"
    
23.         .setrequestHeader "Accept-Language", "zh-CN,zh;q=0.8"
    
24.         .send (pd)
    
25.         js.addcode "renahu=" & .responsetext
    
26.         For j = 1 To js.Eval("renahu.translateResult[0].length")
    
27.             exp = exp & js.Eval("renahu.translateResult[0][" & j - 1 & "].tgt")
    
28.         Next
    
29.         Cells(i, 2) = exp
    
30.      End With
    
31. Next
    
32. End Sub
    
33. Function encodeURI(strText As String) As String
    
34.     With CreateObject("msscriptcontrol.scriptcontrol")
    
35.         .Language = "JavaScript"
    
36.         encodeURI = .Eval("encodeURI('" & Replace(strText, "'", "\'") & "');")
    
37.     End With
    
38. End Function
    

复制代码

学不完用不尽

简化版
有道翻译.rar (13.39 KB, 下载次数: 57)

2018-1-5 23:24 上传

点击文件名下载附件

代码：

1. Public Sub 有道翻译()
   
2. Dim xmlHttp As Object, i%
   
3. Set xmlHttp = CreateObject("MSXML2.XMLHTTP")
   
4. For i = 2 To Range("A1").End(xlDown).Row
   
5. 'xmlHttp.Open "POST", "http://fanyi.youdao.com/translate?smartresult=dict&smartresult=rule&smartresult=ugc&sessionFrom=null", False '可以简化
   
6. xmlHttp.Open "POST", "http://fanyi.youdao.com/translate", False
   
7. xmlHttp.setrequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8"
   
8. 'xmlHttp.Send "type=AUTO&i=" & Replace(Replace(Replace(encodeURI(Cells(i, 1).Value), "%", "%C2%"), "%C2%E", "%C3%A"), "%C2%20", " ") & "&doctype=json&xmlVersion=1.8&keyfrom=fanyi.web&ue=UTF-8&action=FY_BY_CLICKBUTTON&typoResult=true" '可以简化
   
9. xmlHttp.send "i=" & Replace(Replace(Replace(encodeURI(Cells(i, 1).Value), "%", "%C2%"), "%C2%E", "%C3%A"), "%C2%20", " ") & "&doctype=json"
   
10. 
    
11. Do While xmlHttp.readyState <> 4
    
12.    DoEvents
    
13. Loop
    
14. 
    
15. Dim strResponse As String
    
16. strResponse = Trim(xmlHttp.responsetext)
    
17. Cells(i, 2) = Split(Split(strResponse, """tgt"":""")(1), """")(0)
    
18. 'Debug.Print strResponse
    
19. Next i
    
20. End Sub
    
21. Function encodeURI(strText As String) As String
    
22.     With CreateObject("msscriptcontrol.scriptcontrol")
    
23.         .Language = "JavaScript"
    
24.         encodeURI = .Eval("encodeURI('" & Replace(strText, "'", "\'") & "');")
    
25.     End With
    
26. End Function

复制代码

hjboze

太强大了，学习学习