Excel中的Google搜索结果数量

时间:2011-01-21 19:51:51

标签: excel excel-vba vba

在Excel中给出一列字符串,是否有一种简单的方法可以从Google搜索中返回每个字符串的结果数量?我正在寻找一种方法将Excel中的文本数据列表转换为Google搜索结果。

3 个答案:

答案 0 :(得分:5)

创意From here(但已修改):

Public Sub ExcelGoogleSearch()

Dim searchWords As String

With Sheets("Sheet1")
RowCount = 1
Do While .Range("A" & RowCount) <> ""
searchWords = .Range("A" & RowCount).Value

' Get keywords and validate by adding + for spaces between
searchWords = Replace$(searchWords, " ", "+")

' Obtain the source code for the Google-searchterm webpage
search_url = "http://www.google.com/search?hl=en&q=" & searchWords & "&meta="""
Set search_http = CreateObject("MSXML2.XMLHTTP")
search_http.Open "GET", search_url, False
search_http.send
results_var = search_http.responsetext
Set search_http = Nothing

' Find the number of results and post to sheet
pos_1 = InStr(1, results_var, "resultStats>", vbTextCompare)
pos_2 = InStr(3 + pos_1, results_var, ">", vbTextCompare)
pos_3 = InStr(pos_2, results_var, "<nobr>", vbTextCompare)
NumberofResults = Mid(results_var, 1 + pos_2, (-1 + pos_3 - pos_2))
Range("B" & RowCount) = NumberofResults
RowCount = RowCount + 1
Loop
End With
End Sub

alt text

HTH

答案 1 :(得分:1)

此代码需要更新,因为Google稍微更改了源代码。这是一个代码,截止日期为2013年11月11日,适用于任何需要它的人(稍微进行其他修改,宏忽略第一行,因此您可以将列标题和搜索结果转换为值,以便他们准备好操作/用Excel排序。

Public Sub ExcelGoogleSearch()

Dim searchWords As String

With Sheets("Sheet1")
RowCount = 2
Do While .Range("A" & RowCount) <> ""
searchWords = .Range("A" & RowCount).Value

' Get keywords and validate by adding + for spaces between
searchWords = Replace$(searchWords, " ", "+")

' Obtain the source code for the Google-searchterm webpage
search_url = "https://www.google.com/search?hl=en&q=" & searchWords & "&meta="""
Set search_http = CreateObject("MSXML2.XMLHTTP")
search_http.Open "GET", search_url, False
search_http.send
results_var = search_http.responsetext
Set search_http = Nothing

' Find the number of results and post to sheet
pos_1 = InStr(1, results_var, "div id=" & Chr(34) & "resultStats", vbTextCompare) + 21
If pos_1 = 21 Then
NumberofResults = 0
Else
pos_2 = InStr(pos_1, results_var, "result", vbTextCompare) - 1
NumberofResults = Val(Replace(Replace(Mid(results_var, pos_1, pos_2 - pos_1), ",", ""), "About", ""))
End If
Range("B" & RowCount) = NumberofResults
RowCount = RowCount + 1
Loop
End With
End Sub

答案 2 :(得分:0)

上面的代码可以创造奇迹。另一方面,如果搜索的字符串带来0结果,它会崩溃。一个简单的If案例解决了这个问题。只是fyi。

Public Sub ExcelGoogleSearch()

Dim searchWords As String

With Sheets("Sheet1")
RowCount = 1
Do While .Range("A" & RowCount) <> ""
searchWords = .Range("A" & RowCount).Value

' Get keywords and validate by adding + for spaces between
searchWords = Replace$(searchWords, " ", "+")

' Obtain the source code for the Google-searchterm webpage
search_url = "http://www.google.com/search?hl=en&q=""" & searchWords & """&meta="""
Set search_http = CreateObject("MSXML2.XMLHTTP")
search_http.Open "GET", search_url, False
search_http.send
results_var = search_http.responsetext
Set search_http = Nothing

' Find the number of results and post to sheet
pos_1 = InStr(1, results_var, "resultStats>", vbTextCompare)

If pos_1 = 0 Then
  NumberofResults = 0
Else
  pos_2 = InStr(3 + pos_1, results_var, ">", vbTextCompare)
  pos_3 = InStr(pos_2, results_var, "<nobr>", vbTextCompare)
  NumberofResults = Mid(results_var, 1 + pos_2, (-1 + pos_3 - pos_2))
End If

Range("B" & RowCount) = NumberofResults
RowCount = RowCount + 1
Loop
End With
End Sub