Google arama sonuçlarını Excel'deki çalışma sayfasına nasıl aktarabilirsiniz?

Bazı durumlarda, Google'da önemli anahtar kelimelerle arama yapmanız ve en üstteki arama sonuçlarını başlıkları ve makale bağlantılarıyla birlikte bir çalışma sayfasında kaydetmeniz gerekebilir. Bu makale, hücrelerde verilen anahtar kelimelere göre Google arama sonuçlarını çalışma sayfasına aktarmak için bir VBA yöntemi sunmaktadır.

VBA kodu ile Google arama sonuçlarını çalışma sayfasına aktarma

VBA kodu ile Google arama sonuçlarını çalışma sayfasına aktarma

Aşağıdaki ekran görüntüsünde gösterildiği gibi aramak istediğiniz anahtar kelimeler sütun A'da listeleniyorsa, lütfen bu anahtar kelimelerin Google arama sonuçlarını VBA koduyla ilgili sütunlara aktarmak için aşağıdaki adımları izleyin.

1. Microsoft Visual Basic for Applications penceresini açmak için Alt + F11 tuşlarına basın.

2. Microsoft Visual Basic for Applications penceresinde, Ekle > Modül'ü tıklayın. Ardından VBA kodunu kopyalayıp kod penceresine yapıştırın.

VBA kodu: Google arama sonuçlarını çalışma sayfasına aktarma

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 Sub

3. Kodu çalıştırmak için F5 tuşuna basın. Açılacak olan Kutools for Excel iletişim kutusunda, aramak istediğiniz anahtar kelimeleri içeren hücreleri seçin ve ardından Tamam düğmesine tıklayın. Ekran görüntüsüne bakın:

Tüm arama sonuçları, başlıklar ve bağlantılar dahil olmak üzere, anahtar kelimelere göre ilgili sütun hücrelerine aktarılır. Ekran görüntüsüne bakın:

İlgili makaleler:

• Çalışma kitabı açıldığında belirli verilerle birleşik giriş kutusunu nasıl doldurabilirsiniz?
• Excel açılır liste kutusundan değer seçerken diğer hücreleri otomatik olarak doldurmak için nasıl yapılır?
• Excel açılır liste kutusundan değer seçerken diğer hücreleri otomatik olarak doldurmak için nasıl yapılır?