关于使用bing翻译进行批量翻译的请教

硅谷少年

fengxiliu 发表于 2018-11-14 19:26
老师，您好，看到您分享的关于excel中使用有道批量翻译的函数帮助非常大，这里想咨询您一个问题，公式中有 ...

要求返回的是xml才能用这方法，否则要写自定义函数，倒也不太复杂。尽量用最新版本的office，powerquery应该能不用编程解决你的问题。

fshlxy

我看这个，如何调整要翻译的语言

jimmyhwang01

硅谷少年 发表于 2018-9-12 21:24
excel版本不够吧？需要office2013、2016、office365才可以，低版本不行。

请问谷歌翻译的接口如何做？
我要做一个东西也要用到。
http://club.excelhome.net/thread-1477126-1-1.html

硅谷少年

jimmyhwang01 发表于 2019-5-14 13:16
请问谷歌翻译的接口如何做？
我要做一个东西也要用到。
http://club.excelhome.net/thread-1477126-1-1 ...

我谷歌翻译用的这个：

1. Function CN2EN(rng)
   
2.     Dim xml
   
3.     Dim url$, EngSentence$
   
4.     Set xml = CreateObject("MSXML2.XMLHTTP")
   
5.     EngSentence = Escape(rng.Value)
   
6.     url = "https://translate.google.cn/m?hl=zh-CN&sl=zh-CN&tl=en&ie=UTF-8&prev=_m&q=" & EngSentence
   
7.     With xml
   
8.       .Open "GET", url, False
   
9.       .Send
   
10.         If InStr(.ResponseText, "<div dir=""ltr"" class=""t0"">") > 0 Then
    
11.             CN2EN = Split(Split(.ResponseText, "<div dir=""ltr"" class=""t0"">")(1), "</div><")(0)
    
12.         End If
    
13.     End With
    
14. End Function
    
15. Function URLEncodePlus(strURL)
    
16. 'ANSI编码,空格处理成+号
    
17.     Dim i
    
18.     Dim tempStr
    
19.     For i = 1 To Len(strURL)
    
20.         If Asc(Mid(strURL, i, 1)) < 0 Then
    
21.             tempStr = "%" & Right(CStr(Hex(Asc(Mid(strURL, i, 1)))), 2)
    
22.             tempStr = "%" & Left(CStr(Hex(Asc(Mid(strURL, i, 1)))), Len(CStr(Hex(Asc(Mid(strURL, i, 1))))) - 2) & tempStr
    
23.             URLEncodePlus = URLEncodePlus & tempStr
    
24.         ElseIf (Asc(Mid(strURL, i, 1)) >= 65 And Asc(Mid(strURL, i, 1)) <= 90) Or _
    
25.                  (Asc(Mid(strURL, i, 1)) >= 97 And Asc(Mid(strURL, i, 1)) <= 122) Or _
    
26.                  (Asc(Mid(strURL, i, 1)) >= 48 And Asc(Mid(strURL, i, 1)) <= 57) Then
    
27.             URLEncodePlus = URLEncodePlus & Mid(strURL, i, 1)
    
28.         Else
    
29.             tempStr = Mid(strURL, i, 1)
    
30.             Select Case tempStr
    
31.             Case ".", "-", "~", "_"                                               '如果发现网站有其他不需要编码的字符，放在这里
    
32.                 URLEncodePlus = URLEncodePlus & tempStr
    
33.             Case " "
    
34.                 URLEncodePlus = URLEncodePlus & "+"
    
35.             Case Else
    
36.                 URLEncodePlus = URLEncodePlus & "%" & Hex(Asc(tempStr))
    
37.             End Select
    
38.         End If
    
39.     Next
    
40. End Function
    
41. 
    
42. Function GetURL$(txt$)
    
43.     Dim a() As Byte: a = StrConv(txt, vbFromUnicode, &H804)
    
44.     For i = 0 To UBound(a)
    
45.         GetURL = GetURL & IIf(a(i) < 128, Chr(a(i)), "%" & Hex(a(i)))
    
46.     Next
    
47. End Function
    
48. 
    
49. Function Escape(ByVal strText As String) As String
    
50.     Set JS = CreateObjectx86("msscriptcontrol.scriptcontrol")
    
51.     JS.Language = "JavaScript"
    
52.     Escape = JS.Eval("encodeURIComponent('" & Replace(Replace(strText, "'", "\'"), Chr(10), "") & "');")
    
53. End Function

复制代码

lwx228

硅谷少年 发表于 2019-5-15 09:43
我谷歌翻译用的这个：

请教大侠: 能否发个附件成品、谢谢！

zuodaoao

学习 了。。。

lwx228

硅谷少年 发表于 2018-9-12 21:24
excel版本不够吧？需要office2013、2016、office365才可以，低版本不行。

可惜我下载的一个精简office2016、excel用不了、
说是Excel 词典(XLLEX.DLL)文件丢失或损坏

硅谷少年

用这个，这是我最后改良的版本，fy("hello") 返回 你好，fy("你好") 返回 Hello。

1. Function fy(str)
   
2.     Dim xml
   
3.     Dim url$, EngSentence$
   
4.     Set xml = CreateObject("MSXML2.XMLHTTP")
   
5.     EngSentence = UTF8EncodeURI(str)
   
6.     url1 = "https://translate.google.cn/m?hl=en&sl=en&tl=zh-CN&ie=UTF-8&prev=_m&q=" & EngSentence
   
7.     url2 = "https://translate.google.cn/m?hl=en&sl=zh-CN&tl=en&ie=UTF-8&prev=_m&q=" & EngSentence
   
8.     If Asc(Left(str, 1)) > 0 And Asc(Left(str, 1)) < 128 Then url = url1 Else url = url2
   
9.     With xml
   
10.       .Open "GET", url, False
    
11.       .Send
    
12.        If InStr(.ResponseText, "<div dir=""ltr"" class=""t0"">") > 0 Then
    
13.             fy = Split(Split(.ResponseText, "<div dir=""ltr"" class=""t0"">")(1), "</div><")(0)
    
14.         Else
    
15.             MsgBox "Error": Exit Function
    
16.         End If
    
17.     End With
    
18. End Function
    
19. 
    
20. Function UTF8EncodeURI(szInput)
    
21.     Dim wch, uch, szRet
    
22.     Dim x
    
23.     Dim nAsc, nAsc2, nAsc3
    
24.     If szInput = "" Then
    
25.         UTF8EncodeURI = szInput
    
26.         Exit Function
    
27.     End If
    
28.     For x = 1 To Len(szInput)
    
29.         wch = Mid(szInput, x, 1)
    
30.         nAsc = AscW(wch)
    
31.         If nAsc < 0 Then nAsc = nAsc + 65536
    
32.         If (nAsc And &HFF80) = 0 Then
    
33.             szRet = szRet & wch
    
34.         Else
    
35.             If (nAsc And &HF000) = 0 Then
    
36.                 uch = "%" & Hex(((nAsc \ 2 ^ 6)) Or &HC0) & Hex(nAsc And &H3F Or &H80)
    
37.                 szRet = szRet & uch
    
38.             Else
    
39.                 uch = "%" & Hex((nAsc \ 2 ^ 12) Or &HE0) & "%" & _
    
40.                       Hex((nAsc \ 2 ^ 6) And &H3F Or &H80) & "%" & _
    
41.                       Hex(nAsc And &H3F Or &H80)
    
42.                 szRet = szRet & uch
    
43.             End If
    
44.         End If
    
45.     Next
    
46.     UTF8EncodeURI = szRet
    
47. End Function
    

复制代码

于箱长

硅谷少年 发表于 2019-7-25 13:53
用这个，这是我最后改良的版本，fy("hello") 返回 你好，fy("你好") 返回 Hello。

这个厉害，我用大神的代码，成功修改成中韩互译，非常感谢

硅谷少年

硅谷少年 发表于 2019-7-25 13:53
用这个，这是我最后改良的版本，fy("hello") 返回 你好，fy("你好") 返回 Hello。

谷歌改版了原来代码报错了，第12，13行代码， 那个字符串要换成 "<div class=""""result-container"""">"，InStr(.ResponseText, "<div class=""""result-container"""">") 这样才能恢复正常。