vba - Excel 宏从 Google 翻译中查找单词

Question

我有一个 Excel 表，A 列中有近 30.000 个单词，我想创建一个宏来搜索谷歌翻译中的每个单词，获取它们的含义（或翻译），将含义放在 B 列中（或者如果有更多的含义在C列，D列等）由于我有将近30.000个单词，因此自己搜索每个单词是一件非常耗时的事情。如果我可以用宏来做到这一点，那就太好了。有什么建议么？（谷歌翻译对我来说不是“必须的”。如果有其他网站或其他方式可以做到这一点，我愿意接受建议）

注意：我遇到了这个话题，但它并没有像我希望的那样成功。

Answer 1

由于 Google Translate API 不是免费服务，因此执行此操作比较麻烦。但是，我在此页面上找到了使用 vba 翻译文本的解决方法，并且我进行了一些调整，以便它可以用于您的目的。假设原始词输入到电子表格的“A”列中，翻译应该出现在右侧的列中，代码如下：

Sub test()
Dim s As String

Dim detailed_translation_results, basic_translation_results
Dim cell As Range

For Each cell In Intersect(ActiveSheet.Range("A:A"), ActiveSheet.UsedRange)
    If cell.Value <> "" Then
        detailed_translation_results = detailed_translation(cell.Value)

        'Check whether detailed_translation_results is an array value. If yes, each detailed translation is entered into separate column, if not, basic translation is entered into the next column on the right
        On Error Resume Next
            ActiveSheet.Range(cell.Offset(0, 1), cell.Offset(0, UBound(detailed_translation_results) + 1)).Value = detailed_translation_results

            If Err.Number <> 0 Then
                cell.Offset(0, 1).Value = detailed_translation_results
            End If
        On Error GoTo 0
    End If
Next cell

End Sub

Function detailed_translation(str)
' Tools Refrence Select Microsoft internet Control

Dim IE As Object, i As Long, j As Long
Dim inputstring As String, outputstring As String, text_to_convert As String, result_data As String, CLEAN_DATA
Dim FirstTablePosition As Long, FinalTablePosition

Set IE = CreateObject("InternetExplorer.application")

'   Choose input language - Default "auto"

inputstring = "auto"

'   Choose input language - Default "en"

outputstring = "en"

text_to_convert = str

'open website

IE.Visible = False
IE.navigate "http://translate.google.com/#" & inputstring & "/" & outputstring & "/" & text_to_convert

Do Until IE.ReadyState = 4
    DoEvents
Loop

Application.Wait (Now + TimeValue("0:00:5"))

Do Until IE.ReadyState = 4
    DoEvents
Loop

'Firstly, this function tries to extract detailed translation.

Dim TempTranslation() As String, FinalTranslation() As String

FirstTablePosition = InStr(IE.Document.getElementById("gt-lc").innerHTML, "<tbody>")
LastTablePosition = InStr(IE.Document.getElementById("gt-lc").innerHTML, "</tbody>")

On Error Resume Next
TempTranslation() = Split(Mid(IE.Document.getElementById("gt-lc").innerHTML, FirstTablePosition, LastTablePosition - FirstTablePosition), "class=""gt-baf-cell gt-baf-word-clickable"">")

ReDim FinalTranslation(0 To UBound(TempTranslation) - 1)

For j = LBound(TempTranslation) + 1 To UBound(TempTranslation)
    FinalTranslation(j - 1) = Left(TempTranslation(j), InStr(TempTranslation(j), "<") - 1)
Next j
On Error GoTo 0

Dim CheckIfDetailed

'Check whether there is detailed translation available. If not - this function returns a single translation
On Error Resume Next
    CheckIfDetailed = FinalTranslation(LBound(FinalTranslation))

    If Err.Number <> 0 Then
        CLEAN_DATA = Split(Application.WorksheetFunction.Substitute(IE.Document.getElementById("result_box").innerHTML, "</SPAN>", ""), "<")

        For j = LBound(CLEAN_DATA) To UBound(CLEAN_DATA)

            result_data = result_data & Right(CLEAN_DATA(j), Len(CLEAN_DATA(j)) - InStr(CLEAN_DATA(j), ">"))
        Next

        detailed_translation = result_data
        Exit Function

    End If
On Error GoTo 0

IE.Quit

detailed_translation = FinalTranslation()


End Function

请注意，代码非常慢（由于反机器人限制），我不能保证 Google 不会阻止该脚本。但是，它应该可以工作。

您唯一应该做的就是在相应注释标记的位置选择语言。

或者，如果您寻求更快的东西，您可以操纵 Application.Wait 方法（例如将值设置为 0:00:2 而不是 0:00:5）或谷歌 Microsoft Translate。