ExcelマクロVBA技術解説
VBA+SeleniumBasicで検索順位チェッカー(改)

ExcelマクロVBAの問題点と解決策、エクセルVBAの技術的解説
最終更新日:2019-06-22

VBA+SeleniumBasicで検索順位チェッカー(改)


VBAでSeleniumBasicを使って検索順位チェッカーを作り、Google検索順位の履歴を管理します、
既に作成解説した、VBA+SeleniumBasicで検索順位チェッカー作成 こちらの改訂版になります。

VBAでSeleniumBasicを使って検索順位チェッカーを作ってみます。SEO対策として各キーワードでの検索順位チェックは欠かせませんが簡単に使えてキーワードを大量に指定できる良いツールがなかなかありません。Google検索をスクレイピングすることはGoogle利用規約に反する可能性があります。

Google検索をスクレイピングすることは、Google利用規約に反する可能性があります。
ここには技術解説としてVBAコードを掲載しますが、この利用を推奨しているものではありません。
掲載したVBAコードの利用については、個々のご判断でお願いします。

SEO対策として各キーワードでの検索順位チェックは欠かせませんが、
複数のキーワードの検索順位を履歴で見やすく管理しできるようにしています。


今回は技術解説というより、VBA+SeleniumBasic実践編サンプルとしての位置づけになります。

改訂内容
・シートのレイアウト
・Chromeシークレットモード
・エレメントの取得方法
・順位変化をアイコンセット

順位履歴が見やすいようにレイアウト変更
Google順位変動が激しくなっているので、厳密に判定したいのでシークレットモードで起動
Google結果表示が時々で変化するので、より汎用的に変更
一目で分かり安いようにイコンセットで視覚化

※検索されているのに「圏外」となってしまうバグもあったので修正されています。

シート構成

マクロ VBA Selenium

C1:サイトURL
A4~:キーワード(個数制限なし)
B3:取得日時
B4~:検索結果に掲載されているページタイトル
C4~:検索結果に掲載されているページURL
D列:今回順位
E列以降:前日以前の順位履歴

検索順位チェッカーのVBA全コード



Option Explicit

Private Driver As Selenium.WebDriver
Private Const gUrl As String = "https://www.google.co.jp/"
'検索ボックスのCSS selector
Private Const gSearch As String = "#tsf > div:nth-child(2) > div > div.RNNXgb > div > div.a4bIc > input"

Sub RankCheker()
  '起動シートの初期処理
  Dim ws As Worksheet
  Set ws = ActiveSheet
  Dim siteUrl As String
  siteUrl = ws.Range("C1") 'サイトURL
  
  'Seleniumの初期処理
  Dim sKey As New Selenium.Keys
  Dim elm As Selenium.WebElement
  Set Driver = New Selenium.WebDriver
  Driver.AddArgument "--incognito" 'シークレットモード
  Driver.Start "chrome"
  Driver.window.Maximize
  AppActivate Application.Caption
  
  Dim i As Long, cntRank As Long
  Dim myRng As Range
  Dim sAdr1 As String, sAdr2 As String
  With ws
    
    '前回実行日が前日以前なら履歴を残す
    If .Range("D3").Value < Date Then
      Call setHeadFormat(ws)
      Call setDetailFormat(ws)
    End If
    .Range("D3").Value = Now()
    
    '出力範囲を初期クリア
    .Range("A3").CurrentRegion.Offset(1, 1).Resize(, 3).ClearContents
    For i = 4 To .Cells(.Rows.Count, 1).End(xlUp).Row
      Driver.Get gUrl
      AppActivate Application.Caption
      Set elm = Driver.FindElementByCss(gSearch)
      
      '検索ボックスへキーワード送信
      elm.Clear
      elm.SendKeys .Cells(i, 1)
      elm.SendKeys sKey.Enter
      
      '検索結果からサイト掲載要素を取得
      Set elm = getElement(siteUrl, _
                .Cells(i, 1).Value, _
                cntRank)
      If Not elm Is Nothing Then
        .Cells(i, 2) = elm.FindElementByTag("h3").Text
        .Cells(i, 3) = Mid(elm.Attribute("href"), Len(siteUrl) + 1)
        .Cells(i, 4) = cntRank
      Else
        .Cells(i, 4) = "圏外"
      End If
    Next
    
  End With
  
  '終了処理:Close,Quitは無くても良いけど
  Driver.Close
  Driver.Quit
  Set Driver = Nothing
  MsgBox "取得完了"
End Sub

'指定selectorの要素を取得:ページ内に無い場合は「次へ」
Private Function getElement(ByVal siteUrl As String, _
              ByVal sCss As String, _
              ByRef cntRank As Long) _
              As Selenium.WebElement
  Set getElement = Nothing
  Dim elm As Selenium.WebElement
  Dim elms As Selenium.WebElements
  Dim sHref As String
  Dim cntPage As Long
  cntRank = 0
  On Error Resume Next
  Do
    '検索結果表示領域全体
    Set elm = Driver.FindElementByCss("#rso")
    If Err Then Exit Function
    '明細は<div class="g">で繰り返されている
    Set elms = elm.FindElementsByClass("g")
    If Err Then Exit Function
    If elms.Count = 0 Then Exit Function
    For Each elm In elms
      Set elm = elm.FindElementByClass("r").FindElementByTag("a")
      If Err Then
        Err.Clear
      Else
        If sHref <> elm.Attribute("href") Then
          cntRank = cntRank + 1
          If elm.Attribute("href") Like siteUrl & "*" Then
            Set getElement = elm
            Exit Function
          End If
          sHref = elm.Attribute("href")
        End If
      End If
    Next
    
    '10ページまで
    cntPage = cntPage + 1
    If cntPage >= 10 Then
      Exit Function
    End If
    
    Driver.FindElementByLinkText("次へ").Click
    If Err Then
      Exit Function
    End If
  Loop
End Function

'日付履歴追加
Private Sub setHeadFormat(ByVal ws As Worksheet)
  Dim tgRng As Range, myRng As Range
  Dim sAdr1 As String, sAdr2 As String
  With ws
    .Columns("D").Insert
    .Columns("D").ColumnWidth = 4.6
    .Range("D1").Clear
    .Range("D1").NumberFormatLocal = "0"
    .Range("D3").NumberFormatLocal = "m/d"
    .Range("D3").HorizontalAlignment = xlCenter
    .Range("D3").Value = Now()
  End With
End Sub

'明細アイコンセットの設定
Private Sub setDetailFormat(ByVal ws As Worksheet)
  Dim tgRng As Range, myRng As Range
  Dim sAdr1 As String, sAdr2 As String
  
  With ws
    Set tgRng = .Range("A3").CurrentRegion
    Set tgRng = Intersect(tgRng, tgRng.Offset(1, 3))
  End With
  
  tgRng.FormatConditions.Delete
  For Each myRng In tgRng
    sAdr1 = myRng.Address(True, True)
    sAdr2 = myRng.Offset(, 1).Address(True, True)
    With myRng.FormatConditions.AddIconSetCondition
      .IconSet = ws.Parent.IconSets(xl3TrafficLights1)
      .IconCriteria(1).Icon = xlIconGreenUpArrow
      With .IconCriteria(2)
        .Type = xlConditionValueFormula
        .Value = "=" & sAdr2
        .Operator = 7
        .Icon = xlIconNoCellIcon
      End With
      With .IconCriteria(3)
        .Type = xlConditionValueFormula
        .Value = "=IF(" & sAdr2 & "=""""," & sAdr1 & "," & sAdr2 & ")"
        .Operator = 5
        .Icon = xlIconRedDownArrow
      End With
    End With
    With myRng.FormatConditions.Add(Type:=xlExpression, Formula1:="=ISTEXT(" & myRng.Address(False, False) & ")")
      .Interior.Color = vbYellow
    End With
  Next
End Sub



動作が安定しないときは、画面切り替わり直後に適宜待ち時間を入れてください。
Driver.Wait ミリ秒

短時間に大量の検索を行うとエラーになります。
Google検索のスクレイピングはGoogle利用規約に反する可能性もあり、
過度な検索実行は控えてください。

最後に

掲載したVBAについては、ご自由に改変してお使いください。

当初作成より見やすくなったと思います。
今後の課題としては、
エクセルなので、定時起動してのチェックができないのが一番の悩みです。
GAS(Google Apps Script)ならトリガーで簡単に実現できるので今後検討したいと思っています。



同じテーマ「マクロVBA技術解説」の記事

オブジェクト式について
オブジェクトの探索方法
条件付きコンパイル(32ビット64ビットの互換性)
ドキュメントプロパティ(BuiltinDocumentProperties,CustomDocumentProperties)
VBAでファイルを規定のアプリで開く方法
Excelアドインの作成と登録について
VBAでのタイマー処理(SetTimer,OnTime)
マクロでShift_JIS文字コードか判定する
VBA+SeleniumBasicで検索順位チェッカー(改)
Applicationを省略できるApplicationのメソッド・プロパティ一覧
PowerQueryの強力な機能をVBAから利用する方法


新着記事NEW ・・・新着記事一覧を見る

Byte配列と文字コード関数について|VBA技術解説(8月20日)
PowerQueryの強力な機能をVBAから利用する方法|VBA技術解説(8月4日)
練習問題31(セル結合を解除して値を埋める)|VBA練習問題(7月30日)
練習問題30(マトリックス→リスト形式)|VBA練習問題(7月25日)
Applicationを省略できるApplicationのメソッド・プロパティ一覧|VBA技術解説(7月22日)
コレクション(Collection)の並べ替え(Sort)に対応するクラス|VBA技術解説(7月20日)
CSVの読み込み方法(ジャグ配列)|VBAサンプル集(7月15日)
その他のExcel機能(グループ化、重複の削除、オートフィル等)|VBA入門(7月14日)
オートフィルタ退避回復クラスを複数シート対応させるVBAクラス|VBA技術解説(7月6日)
オートフィルタを退避回復するVBAクラス|VBA技術解説(7月6日)


アクセスランキング ・・・ ランキング一覧を見る

1.最終行の取得(End,Rows.Count)|VBA入門
2.セルのコピー&値の貼り付け(PasteSpecial)|VBA入門
3.RangeとCellsの使い方|ExcelマクロVBA入門
4.Range以外の指定方法(Cells,Rows,Columns)|VBA入門
5.変数とデータ型(Dim)|ExcelマクロVBA入門
6.繰り返し処理(For Next)|ExcelマクロVBA入門
7.マクロって何?VBAって何?|ExcelマクロVBA入門
8.セルに文字を入れるとは(Range,Value)|VBA入門
9.ひらがな⇔カタカナの変換|エクセル基本操作
10.空白セルを正しく判定する方法(IsEmpty,IsError,HasFormula)|VBA技術解説



  • >
  • >
  • >
  • VBA+SeleniumBasicで検索順位チェッカー(改)

  • このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。


    記述には細心の注意をしたつもりですが、
    間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
    なお、掲載のVBAコードは自己責任で使ってください。万一データ破損等の損害が発生しても責任は負いません。




    このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
    本文下部へ