如何在Excel中快速定义单词列表

时间:2015-07-20 05:25:27

标签: excel vba excel-vba dictionary

我在A栏中有一个很大的单词列表。我想使用excel批量查找每个单词的google或bing定义。 Excel具有内置功能,可以显示bing定义,但您必须手动为每个单词执行此操作。

我尝试了下面链接中列出的方法,但它已经过时了,函数会一直返回错误"公式中使用的值是错误的数据类型" Finding the English definition of a word in VBA

如果有人知道某个程序或网站会在谷歌定义中查找大量单词列表,那么这些单词也很有用。

1 个答案:

答案 0 :(得分:1)

应该有比我下面的代码更有效的方法。它使用来自Dictionary.com的服务。

你可以在工作表中使用它作为一个功能,比如你有"披萨"在 A1 中,然后在 A2 中,您使用=DictReference(A1)来显示定义。但是我只将它编码为返回第一个定义。

Option Explicit

Const URL_SEARCH = "http://dictionary.reference.com/browse/<WORD>?s=t"

Function DictReference(ByVal SearchWord As Variant) As String
    On Error Resume Next
    Dim sWord As String, sTxt As String
    sWord = CStr(SearchWord)
    With CreateObject("WinHttp.WinHttpRequest.5.1")
        .Open "GET", Replace(URL_SEARCH, "<WORD>", sWord), False
        .Send
        If .Status = 200 Then
            sTxt = StrConv(.ResponseBody, vbUnicode)
            ' The definition of the searched word is in div class "def-content"
            sTxt = Split(sTxt, "<div class=""def-content"">")(1)
            sTxt = Split(sTxt, "</div>")(0)
            ' Remove all unneccessary whitespaces
            sTxt = Replace(sTxt, vbLf, "")
            sTxt = Replace(sTxt, vbCr, "")
            sTxt = Replace(sTxt, vbCrLf, "")
            sTxt = Trim(sTxt)
            ' Remove any HTML codes within
            sTxt = StripHTML(sTxt)
        Else
            sTxt = "WinHttpRequest Error. Status: " & .Status
        End If
    End With
    If Err.Number <> 0 Then sTxt = "Err " & Err.Number & ":" & Err.Description
    DictReference = sTxt
End Function

Private Function StripHTML(ByVal sHTML As String) As String
    Dim sTmp As String, a As Long, b As Long
    sTmp = sHTML
    Do Until InStr(1, sTmp, "<", vbTextCompare) = 0
        a = InStr(1, sTmp, "<", vbTextCompare) - 1
        b = InStr(a, sTmp, ">", vbTextCompare) + 1
        sTmp = Left(sTmp, a) & Mid(sTmp, b)
    Loop
    StripHTML = sTmp
End Function