Excel宏可以从Google翻译中查找单词

时间:2015-08-23 09:13:06

标签: excel vba excel-vba google-translate vocabulary

我在A栏中有一张Excel表格,里面有近30,000个单词,我想创建一个宏来搜索谷歌翻译中的每个单词,得到它们的意思(或翻译),把这些单词放在B栏中(或者如果有更多的话)比C列,D列等更多含义) 由于我有近30,000个单词,所以自己搜索每个单词是一件非常耗时的事情。如果我能用宏来做这件事会很棒。 有什么建议? (谷歌翻译不是"必须"对我来说。如果有其他网站或其他方式这样做,我愿意接受建议)

注意:我遇到了this主题,但它没有达到我希望的效果。

1 个答案:

答案 0 :(得分:0)

由于Google Translate API不是免费服务,因此它很难执行此操作。但是,我在此页Translate text using 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)或google for Microsoft Translate。