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

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

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


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

VBAでSeleniumBasicを使って検索順位チェッカーを作ってみます。SEO対策として各キーワードでの検索順位チェックは欠かせませんが簡単に使えてキーワードを大量に指定できる良いツールがなかなかありません。そこでエクセルVBAでSeleniumBasicを使いGoogleの検索結果から順位を取得する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 ミリ秒


最後に

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

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




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

VBAでのInternetExplorer自動操作
VBAでのSQLの基礎(SQL:Structured Query Language)
VBAで正規表現を利用する(RegExp)
VBAでメール送信する(CDO:Microsoft Collaboration Data Objects)
VBAでのOutlook自動操作
ADO(ActiveX Data Objects)の使い方の要点
特殊フォルダの取得(WScript.Shell,SpecialFolders)
参照設定、CreateObject、オブジェクト式の一覧
VBAのスクレイピングを簡単楽にしてくれるSelenium
VBA+SeleniumBasicで検索順位チェッカー作成
VBA+SeleniumBasicで検索順位チェッカー(改)

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

Withステートメントの実行速度と注意点|VBA技術解説(6月6日)
VBA+SeleniumBasicで検索順位チェッカー(改)|VBA技術解説(6月2日)
マクロでShift_JIS文字コードか判定する|VBA技術解説(6月1日)
Shift_JISのテキストファイルをUTF-8に一括変換|VBAサンプル集(5月31日)
「VBAによる解析シリーズその2 カッコ」をやってみた|エクセル(5月21日)
VBA+SeleniumBasicで検索順位チェッカー作成|VBA技術解説(5月18日)
テーブル操作のVBAコード(ListObject)|VBA入門(5月12日)
テーブル操作の概要(ListObject)|VBA入門(5月12日)
VBAのスクレイピングを簡単楽にしてくれるSelenium|VBA技術解説(5月6日)
Excelワークシート関数一覧(2010以降)|VBAリファレンス(4月22日)

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

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



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

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


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






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

    本文下部へ