Google検索結果で表示される、関連キーワードを自動取得する

Google検索すると、検索結果の一番下に１０個くらいの関連キーワードが表示されます。
（スマホで検索すると、スマホ ランキング、スマホ アンドロイド、スマホ 最新など）

検索結果下の関連キーワードを自動取得したいです。

A1、B1、C1・・・・と検索するキーワードが記入してあり、
その下へ、１０個くらいの関連キーワードが記入されるのが理想です。

これは、Excelのマクロとかで実現可能でしょうか？
それは、どのような記述でできるでしょうか？

よろしくお願いいたします。

No.1 ベストアンサー 回答者： Qchan1962 回答日時： 2020/03/07 16:46

＞これは、Excelのマクロとかで実現可能でしょうか？

可能です。　スクレイピング

＞それは、どのような記述でできるでしょうか？
なれれば、さほど難しくはありませんが、HTMLの知識が少し必要です。
また、対象によっては、出来ない又は、難しくなります。

ご質問の場合、さほど難しくないと思います。

質問者がどの程度VBAの知識があるのか分かりませんが、説明の方が難しいので書いてみます。
コメントで書いている部分を参考に調べてください。

＞A1、B1、C1・・・・と検索するキーワードが記入してあり
これに関しては、後で考えてください。

取り敢えずシートインデックス1のシートの　A1セルにキーワードがありA2セルより下に関連キーワード10を出力します。
尚、参照設定などが必要なので設定してください。
スクレイピング先のHTMLに変更などが発生した場合、機能しなくなります。
ブラウザはIEを使いますので、インストールされていない場合、エラーが返ると思います。

Option Explicit
Sub testGoogleIE()
'要：参照設定///
'Microsoft HTML Object Library
'Microsoft Internet Controls
'///
Dim objIE As InternetExplorer
Dim htmlDoc As HTMLDocument
Dim TargetURL As String
Dim Str As Object, i As Long
　　'カラムループ？（"A"部分を変数に）
TargetURL = "https://www.google.com/search?q=" & Sheets(1).Cells(1, "A")　　'キーワード
Set objIE = CreateObject("Internetexplorer.Application")　　'新しいIEオブジェクトを作成してセット
objIE.Visible = True　　　　 'IEを表示
objIE.navigate TargetURL　　 'IEでURLを開く
Call WaitResponse(objIE)　　 '読み込み待ち
Set htmlDoc = objIE.document　　'objIEで読み込まれているHTMLドキュメントをセット
Sheets(1).Range("A2:A11").ClearComments　　'セル範囲をクリアー
　　i = 1
　　For Each Str In htmlDoc.getElementsByClassName("nVcaUb")　　'ソースより判断
　　　　Sheets(1).Cells(i + 1, "A") = Str.innerText　　'セルに書き込み
　　'Debug.Print Str.innerText　’テスト用
　　　　i = i + 1
　　Next Str
　　objIE.Quit　　　　　　　 'IEを閉じる
　　Set htmlDoc = Nothing
　　Set objIE = Nothing
　　'カラムループ？
　　Sheets(1).Range("A1").Select　　'セル選択(終了時)
End Sub

Sub WaitResponse(objIE As Object)
　　Do While objIE.Busy = True Or objIE.ReadyState < READYSTATE_COMPLETE
　　　　DoEvents
　　Loop
End Sub

No.2 回答者： Qchan1962 回答日時： 2020/03/09 23:21

h2inoutさん

03/09に他の質問を建てていますが、リアクション無い方ですか？