ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 4152|回复: 12

[求助] EXCEL GOOGLE翻译功能 问题

[复制链接]

TA的精华主题

TA的得分主题

发表于 2020-8-25 15:56 | 显示全部楼层 |阅读模式
本帖最后由 976190982 于 2020-8-26 10:26 编辑



事情是这样的,我是搞外贸的,最近搞了一个品牌,需要中文翻译英文,无奈想找一个好点的翻译代码,于是找我朋友,朋友扔过来,他也不懂,实在是没法了,于是向老师们请教。


translateFrom = "zh"  源语言
translateTo = "en" 目标语言      实测定义好后,其余不需要修改
  1. Sub TranslateCell()
  2.     Dim getParam As String, trans As String, translateFrom As String, translateTo As String
  3.     translateFrom = "zh"
  4.     translateTo = "en"
  5.     Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
  6.     Dim r As Range, cell As Range
  7.     Set cell = Selection
  8.     For Each cell In Selection.Cells
  9.         getParam = ConvertToGet(cell.Value)
  10.         URL = "https://translate.google.cn/m?hl=" & translateFrom & "&sl=" & translateFrom & "&tl=" & translateTo & "&ie=UTF-8&prev=_m&q=" & getParam
  11.         objHTTP.Open "GET", URL, False
  12.         objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
  13.         objHTTP.send ("")
  14.         If InStr(objHTTP.responseText, "div dir=""ltr""") > 0 Then
  15.             trans = RegexExecute(objHTTP.responseText, "div[^""]*?""ltr"".*?>(.+?)</div>")
  16.             cell.Value = Clean(trans)
  17.         Else
  18.             MsgBox ("Error")
  19.         End If
  20.     Next cell
  21. End Sub


  22. Function ConvertToGet(val As String)
  23.     val = Replace(val, " ", "+")
  24.     val = Replace(val, vbNewLine, "+")
  25.     val = Replace(val, "(", "%28")
  26.     val = Replace(val, ")", "%29")
  27.     ConvertToGet = val
  28. End Function

  29. Function Clean(val As String)
  30.     val = Replace(val, """, """")
  31.     val = Replace(val, "%2C", ",")
  32.     val = Replace(val, "'", "'")
  33.     Clean = val
  34. End Function

  35. Public Function RegexExecute(str As String, reg As String, _
  36.                              Optional matchIndex As Long, _
  37.                              Optional subMatchIndex As Long) As String
  38.     On Error GoTo ErrHandl
  39.     Set regex = CreateObject("VBScript.RegExp"): regex.Pattern = reg
  40.     regex.Global = Not (matchIndex = 0 And subMatchIndex = 0) 'For efficiency
  41.     If regex.Test(str) Then
  42.         Set matches = regex.Execute(str)
  43.         RegexExecute = matches(matchIndex).SubMatches(subMatchIndex)
  44.         Exit Function
  45.     End If
  46. ErrHandl:
  47.     RegexExecute = CVErr(xlErrValue)
  48. End Function
复制代码
我测试的结果如下


1、会被封ip,太多次就会。
2、使用方式是 先选取要翻译的区域然后运行TranslateCell,即可,但是太多了,会被封掉,求老师们帮忙瞅一下,麻烦了
3、另附一个问题,我需要翻译的数据放在A列,翻译结果放在B列,求老师们帮忙改,对于做外贸的我,这个实在是刚需啊。求老师们帮助。
翻译.zip (13.85 KB, 下载次数: 33)


在此感谢经常帮助我的老师,@liulang0808   @chxw68   @一把小刀闯天下,还有其余跟多老师,在此就不提名了,谢谢你们,也谢谢这个论坛。

我费劲心思找到了原网站https://analystcave.com/excel-google-translate-functionality/

由于是国外的网站我准备了图片,希望能帮到老师们
图片上传后不清晰,麻烦老师们下载图片附件 Excel Google Translate functionality - Analyst Cav.zip (598.44 KB, 下载次数: 27)

Excel Google Translate functionality - Analyst Cav.png

老师们,我在论坛找到了相关的文档,是自定义公式版本,但是没有VBA版本的,(因实际需要中,是一个宏里面也是之前老师帮助写的,所以想跟那个宏一起同步使用)所以想求老师们帮助改成指定区域循环的,本人功力浅薄,只能求助于老师们。
http://club.excelhome.net/thread-1508743-2-1.html

代码如下:
  1. Public Function EnToCh(Rng As String)
  2.     Dim xml
  3.     Dim URL$, EngSentence$
  4.     Set xml = CreateObject("MSXML2.XMLHTTP")
  5.     aasc = Asc(Rng)
  6.     If aasc > 64 And aasc < 123 Then
  7.         URL = "enN&tl=zh-CN&ie=UTF-8&prev=_m&q=" & Rng
  8.     Else
  9.         URL = "zh-CN&tl=enN&ie=UTF-8&prev=_m&q=" & GetURL(Rng)
  10.     End If
  11.     URL = "https://translate.google.cn/m?hl=en&sl=" & URL
  12.     With xml
  13.         .Open "GET", URL, False
  14.         .send
  15.         V = .responseText
  16. '        Debug.Print V '
  17.         If InStr(V, "t0"">") > 0 Then
  18.             EnToCh = Replace(Split(Split(V, "t0"">")(1), "<")(0), "'", "'")
  19.         End If
  20.     End With
  21. End Function

  22. Function ChrU(txt)
  23.     txt = "\u6666" & txt
  24.     sr = Split(txt, "\u") '按汉字单位拆分
  25.     For i = 0 To UBound(sr) '遍历
  26.         If Len(sr(i)) > 3 Then sr(i) = ChrW("&H" & Left(sr(i), 4)) & Mid(sr(i), 5)
  27.         '如果4个字符以上 则取前4个字符(汉字的16进制国际双位码值) 添加"&H"转为16进制数
  28.      '然后用ChrW函数即可返回汉字
  29.     Next
  30.     ChrU = Mid(Join(sr, ""), 2) '把转换后的汉字以及其余字符合并起来返回
  31. End Function

  32. Function sjc$() '时间戳
  33. 'sjc = (Now - 25569 - 1 / 3) * 86400
  34. sjc = (Now - 25570 + 2 / 3) * 86400 + 100
  35. sjc = "=" & Left(sjc & Rnd * 100000, 13)
  36. 'Debug.Print sjc
  37. End Function

  38. Function GetURL$(txt$)
  39. 'Dim a() As Byte
  40. 'a = StrConv(txt, vbFromUnicode, &H804)
  41.     For i = 1 To Len(txt)
  42.         txt1 = Mid(txt, i, 1)
  43.         If Abs(Asc(txt1)) < 128 Then
  44.             GetURL = GetURL & txt1
  45.         Else
  46.             GetURL1 = Application.Hex2Bin(Left(Hex(AscW(txt1)), 2), 8)
  47.             GetURL1 = GetURL1 & Application.Hex2Bin(Right(Hex(AscW(txt1)), 2), 8)
  48.             GetURL1 = Application.Replace(Application.Replace(GetURL1, 11, , 10), 5, , 10)
  49.             GetURL2 = "%E" & Application.Bin2Hex(Left(GetURL1, 4))
  50.             GetURL2 = GetURL2 & "%" & Application.Bin2Hex(Mid$(GetURL1, 5, 8))
  51.             GetURL2 = GetURL2 & "%" & Application.Bin2Hex(Mid$(GetURL1, 13, 8))
  52.             GetURL = GetURL & GetURL2
  53.         End If
  54.     Next
  55. End Function
  56. '如果一律转码是: GetURL = GetURL & "%" & Right("0" & Hex(a(i)), 2)

复制代码



TA的精华主题

TA的得分主题

 楼主| 发表于 2020-8-26 09:33 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2020-8-26 16:33 | 显示全部楼层
谷歌翻译,有道翻译,百度翻译都行?

TA的精华主题

TA的得分主题

发表于 2020-8-26 16:49 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
如果懂一点VBA,自己看百度翻译的API技术文档。不懂用就python,他给提供写好了的。

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-8-26 20:22 | 显示全部楼层
qcw911 发表于 2020-8-26 16:33
谷歌翻译,有道翻译,百度翻译都行?

有道翻译不准确

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-8-26 20:23 | 显示全部楼层
tspliu 发表于 2020-8-26 16:49
如果懂一点VBA,自己看百度翻译的API技术文档。不懂用就python,他给提供写好了的。

谢谢回复    我正在参考

TA的精华主题

TA的得分主题

发表于 2020-8-26 20:30 来自手机 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
搞外贸的不是自己可以翻译吗?还要借助翻译呀

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-8-26 20:58 | 显示全部楼层
1055751654 发表于 2020-8-26 20:30
搞外贸的不是自己可以翻译吗?还要借助翻译呀

没办法啊  手工翻译 数据也特多了

TA的精华主题

TA的得分主题

发表于 2020-8-27 08:39 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
976190982 发表于 2020-8-26 20:23
谢谢回复    我正在参考

我是用的华为云里的各种识别功能(主要是ocr),我也不会写,都直接下载的华为提供的SDK,把参数修改成自己的,然后把得到的JSON格式数据转换成表格需要的样式就行了

TA的精华主题

TA的得分主题

发表于 2020-8-27 08:53 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
用Excel进行翻译,VBA代码虽然可以处理http请求,但现在谷歌的http请求链接用限制,翻译不了多少。我们现在开发了一个翻译函数GoogleTranslateByWebBrowser(),借助浏览器调用谷歌翻译网页,还能批量翻译,这样就不受限,除了谷歌,还有百度、有道、微软、DeepL、阿里云翻译等。
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-11-1 04:21 , Processed in 0.052080 second(s), 9 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表