Hoe Google-zoekresultaten in een werkblad in Excel te plaatsen?
In sommige gevallen moet u mogelijk belangrijke trefwoordzoekopdrachten uitvoeren in Google en de records van de beste zoekresultaten bewaren in een werkblad, inclusief de titel en hyperlink van het artikel. Dit artikel biedt een VBA-methode om Google-zoekresultaten te plaatsen in een werkblad op basis van gegeven trefwoorden in cellen.
Google-zoekresultaten met VBA-code in een werkblad plaatsen
Google-zoekresultaten met VBA-code in een werkblad plaatsen
Stel dat de trefwoorden die u wilt zoeken, vermeld staan in kolom A zoals in onderstaande schermafbeelding te zien is, voer dan als volgt te werk om de Google-zoekresultaten van deze trefwoorden naar de bijbehorende kolommen te plaatsen met VBA-code.
1. Druk op de toetsen Alt + F11 om het Microsoft Visual Basic for Applications-venster te openen.
2. Klik in het Microsoft Visual Basic for Applications-venster op Invoegen > Module. Kopieer en plak vervolgens de VBA-code in het codevenster.
VBA-code: Google-zoekresultaten in een werkblad plaatsen
Sub xmlHttp()
'Updated by Extendoffice 2018/1/30
Dim xRg As Range
Dim url As String
Dim xRtnStr As String
Dim I As Long, xLastRow As Long
Dim xmlHttp As Object, xHtml As Object, xHtmlLink As Object
On Error Resume Next
Set xRg = Application.InputBox("Please select the keywords you will search in Google：", "KuTools for Excel", Selection.Address, , , , , 8)
If xRg Is Nothing Then Exit Sub
Application.ScreenUpdating = False
xLastRow = xRg.Rows.Count
Set xRg = xRg(1)
For I = 0 To xLastRow - 1
url = "https://www.Google.co.in/search?q=" & xRg.Offset(I) & "&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 xHtml = CreateObject("htmlfile")
xHtml.body.innerHTML = xmlHttp.ResponseText
Set xHtmlLink = xHtml.getelementbyid("rso").getelementsbytagname("H3")(0).getelementsbytagname("a")(0)
xRtnStr = Replace(xHtmlLink.innerHTML, "<EM>", "")
xRtnStr = Replace(xRtnStr, "</EM>", "")
xRg.Offset(I, 1).Value = xRtnStr
xRg.Offset(I, 2).Value = xHtmlLink.href
Next
Application.ScreenUpdating = True
End Sub3. Druk op de F5-toets om de code uit te voeren. Selecteer in het pop-upvenster van Kutools voor Excel de cellen met de trefwoorden die u wilt zoeken en klik vervolgens op de knop OK. Zie schermafbeelding:
Alle zoekresultaten, inclusief titels en links, worden vervolgens ingevuld in de bijbehorende celkolommen op basis van de trefwoorden. Zie schermafbeelding:
Gerelateerde artikelen:
- Hoe een combobox te vullen met gespecificeerde gegevens bij het openen van een Werkboek?
- Hoe andere cellen automatisch te vullen bij het selecteren van waarden in een Excel-keuzelijst?
- Hoe andere cellen automatisch te vullen bij het selecteren van waarden in een Excel-keuzelijst?
Beste productiviteitstools voor Office
Verbeter je Excel-vaardigheden met Kutools voor Excel en ervaar ongeëvenaarde efficiëntie. Kutools voor Excel biedt meer dan300 geavanceerde functies om je productiviteit te verhogen en tijd te besparen. Klik hier om de functie te kiezen die je het meest nodig hebt...
Office Tab brengt een tabbladinterface naar Office en maakt je werk veel eenvoudiger
- Activeer tabbladbewerking en -lezen in Word, Excel, PowerPoint, Publisher, Access, Visio en Project.
- Open en maak meerdere documenten in nieuwe tabbladen van hetzelfde venster, in plaats van in nieuwe vensters.
- Verhoog je productiviteit met50% en bespaar dagelijks honderden muisklikken!
Alle Kutools-invoegtoepassingen. Eén installatieprogramma
Kutools for Office-suite bundelt invoegtoepassingen voor Excel, Word, Outlook & PowerPoint plus Office Tab Pro, ideaal voor teams die werken met Office-toepassingen.
- Alles-in-één suite — invoegtoepassingen voor Excel, Word, Outlook & PowerPoint + Office Tab Pro
- Eén installatieprogramma, één licentie — in enkele minuten geïnstalleerd (MSI-ready)
- Werkt beter samen — gestroomlijnde productiviteit over meerdere Office-toepassingen
- 30 dagen volledige proef — geen registratie, geen creditcard nodig
- Beste prijs — bespaar ten opzichte van losse aanschaf van invoegtoepassingen