VBA EXCEL GOOGLE LOOKUP

Я нашел код VBA excel, который позволил найти диапазон ключевых слов в google и вернул первую ссылку. Я хочу добавить окно ввода в начале, чтобы сказать, чтобы получить 5 лучших ссылок. У меня есть 2000 ключевых слов, которые мне нужно найти в google и вернуть несколько ссылок. Может кто-то, пожалуйста, помогите мне развернуть этот код, чтобы сделать это ???? Спасибо огромное!

Вот код, предоставленный другим пользователем stackoverflow:

Sub XMLHTTP ()

Dim url As String, lastRow As Long Dim XMLHTTP As Object, html As Object, objResultDiv As Object, objH3 As Object, link As Object Dim start_time As Date Dim end_time As Date lastRow = Range("A" & Rows.Count).End(xlUp).Row Dim cookie As String Dim result_cookie As String start_time = Time Debug.Print "start_time:" & start_time For i = 2 To lastRow url = "https://www.google.co.in/search?q=" & Cells(i, 1) & "&rnd=" & WorksheetFunction.RandBetween(1, 10000) Set XMLHTTP = CreateObject("MSXML2.serverXMLHTTP") XMLHTTP.Open "GET", url, False XMLHTTP.setRequestHeader "Content-Type", "text/xml" XMLHTTP.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; rv:25.0) Gecko/20100101 Firefox/25.0" XMLHTTP.send Set html = CreateObject("htmlfile") html.body.innerHTML = XMLHTTP.ResponseText Set objResultDiv = html.getelementbyid("rso") Set objH3 = objResultDiv.getelementsbytagname("H3")(0) Set link = objH3.getelementsbytagname("a")(0) str_text = Replace(link.innerHTML, "<EM>", "") str_text = Replace(str_text, "</EM>", "") Cells(i, 2) = str_text Cells(i, 3) = link.href DoEvents Next end_time = Time Debug.Print "end_time:" & end_time Debug.Print "done" & "Time taken : " & DateDiff("n", start_time, end_time) MsgBox "done" & "Time taken : " & DateDiff("n", start_time, end_time) End Sub 

Столбец A был ключевым словом, в столбце B была ссылка Name, C – ссылка. Я хочу сохранить этот формат, но добавьте еще несколько ссылок между каждым ключевым словом. Это означает, что если A1 имеет ключевое слово «hello», тогда B1 будет первым именем ссылки, а C1 будет ссылкой. B2 будет следующим именем ссылки и C2 следующей ссылкой, B3 next …. и т. Д. Также, если в моем списке есть A1 с «привет» и A2 с «hawaii», тогда моя ячейка A2 будет перенесена на A6 после 5 новых имен и ссылок.

Спасибо всем за вашу помощь заранее. Вы действительно спасете меня!

Вы задали много разных вопросов, но чтобы ответить на то, что я воспринимаю как главную проблему, эта строка:

 Set objH3 = objResultDiv.getelementsbytagname("H3")(0) 

это то, что контролирует, на какую ссылку обращается код. Поэтому, изменив значение 0 на 1, теперь будет обработано второе звено. Написав простой цикл, вы можете обработать пятерку ссылок. Я бы предложил сначала переформатировать ваши данные, чтобы оставить достаточно пробелов, чтобы заполнить пять записей, а затем использовать простой подход к циклу, например, который работает, но может занять некоторое время на 1000 терминов (также я переключил его, чтобы начать с A1, как вы сказали ):

 Sub XMLHTTP() Dim url As String, lastRow As Long Dim XMLHTTP As Object, html As Object, objResultDiv As Object, objH3 As Object, link As Object Dim start_time As Date Dim end_time As Date lastRow = Range("A" & Rows.Count).End(xlUp).Row Dim cookie As String Dim result_cookie As String Dim Z As Long Dim Y As Long Z = lastRow Y = 2 'adds the blank rows for all 5 results While Y <= Z Rows(Y & ":" & Y).Select Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove Y = Y + 5 Z = Z + 4 Wend lastRow = (lastRow - 1) * 4 + lastRow start_time = Time Debug.Print "start_time:" & start_time 'starts at A1 For i = 1 To lastRow url = "https://www.google.co.in/search?q=" & Cells(i, 1) & "&rnd=" & WorksheetFunction.RandBetween(1, 10000) Set XMLHTTP = CreateObject("MSXML2.serverXMLHTTP") XMLHTTP.Open "GET", url, False XMLHTTP.setRequestHeader "Content-Type", "text/xml" XMLHTTP.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; rv:25.0) Gecko/20100101 Firefox/25.0" XMLHTTP.send Set html = CreateObject("htmlfile") html.body.innerHTML = XMLHTTP.ResponseText Set objResultDiv = html.getelementbyid("rso") 'loops through the first 5 results For g = 0 To 4 Set objH3 = objResultDiv.getelementsbytagname("H3")(g) Set link = objH3.getelementsbytagname("a")(0) str_text = Replace(link.innerHTML, "<EM>", "") str_text = Replace(str_text, "</EM>", "") Cells((i + g), 2) = str_text Cells((i + g), 3) = link.href DoEvents Next i = i + 4 Next end_time = Time Debug.Print "end_time:" & end_time Debug.Print "done" & "Time taken : " & DateDiff("n", start_time, end_time) MsgBox "done" & "Time taken : " & DateDiff("n", start_time, end_time) End Sub 
Interesting Posts

Excel vba гистограмма

Сложный макрос Excel VBA с контуром

Использование INDIRECT () с функцией INDEX ()

Встраивание изображений, которые будут использоваться с VBA при необходимости

Пользовательская форма VBA не заполняется при первом открытии, но работает во второй раз

Группировка строк Excel на основе аналогичных значений с использованием VBA

Неверное значение при подсчете ячеек в разных версиях Excel

Проблема с развертыванием надстройки Excel

Использование смещения для изменения данных в заданном порядке в VBA

Объединение данных в рабочие книги в Excel

Альтернативный интерфейс для Excel 2007 для SSAS Cube

Как экспортировать переменную DataTable в EXCEL и загрузить Excel

Скопируйте рабочий лист в новую книгу и нажмите кнопку «Макро» в новой книге?

Использование условного форматирования с помощью наборов значков с шестью условиями

Можно ли открыть проводник Windows из метки ссылок

Давайте будем гением компьютера.