ExcelVBAで一括最寄駅検索

スポンサーリンク

210121追記:エラーにより下記コードは動作しません

コメントいただいて調査したのですが、サイトが更新されているため下記コードは動作しなくなっています。

最寄駅を検索するのは面倒

すごく稀なケースだと思いますが、先日同僚が営業先一覧の住所から最寄り駅を調べて資料を作成していました。

400件くらいあり、今後も継続で行わなければならない仕事のようだったのでVBAを使ってお助けのツールを作成しました。
頻度はめちゃくちゃ低いかもしれませんが、どこかで誰かの役に立てるかもしれないのでご紹介します。

スポンサーリンク

使用するツールはYahoo地図検索

Yahoo地図は住所を入力すると最寄り駅と最寄り駅までの所要時間を教えてくれます。
今回はVBAを用いてこのサイトにデータを入力し、必要な情報を抽出するコードを考えてみました。

今回作成したVBAコードとExcelのファイル

今回作成したVBAコードとExcelのシートは以下のものです。
ExcelのシートのA列に記載された住所の最寄り駅を2つとその所要時間をYahoo地図の情報から抽出し、B~E列に記載するコードです。

動作が多少不安定ですが手で一つ一つ調べるよりもだいぶスムーズだと思います。

最寄駅検索ファイル

Declare Sub Sleep Lib “kernel32” (ByVal dwMilliseconds As Long)

Sub 乗り換え検索2()

Dim 住所() As String
Dim i As Long
Dim IE As Object
Dim txtInput(16) As Object
Dim button As Object

i = 0
Do Until Cells(i + 3, 1).Value = “”

ReDim Preserve 住所(i) As String
住所(i) = Cells(i + 3, 1).Text

’IE立上げ

Set IE = CreateObject(“InternetExplorer.application”)
IE.Visible = True
IE.navigate (“https://map.yahoo.co.jp/maps”)

Do While IE.Busy
DoEvents
Sleep 1
Loop
Sleep 2000

’乗り換え案内検索条件入力

Set txtInput(0) = IE.document.getElementByid(“yschsp”)
txtInput(0).innerText = 住所(i)

Set button = IE.document.getElementByid(“search”)
button.Click

Do While IE.Busy
DoEvents
Sleep 1
Loop
Sleep 1000

’乗り換え案内結果集計

Set txtInput(1) = IE.document.getElementsByClassName(“stationname”)(0)
Cells(i + 3, 2).Value = txtInput(1).innerText

Set txtInput(2) = txtInput(1).parentElement.getElementsByTagName(“span”)(0)
Cells(i + 3, 3).Value = txtInput(2).innerText
’親要素のspanタグの値を取得する

On Error Resume Next

Set txtInput(3) = IE.document.getElementsByClassName(“stationname”)(1)
Cells(i + 3, 4).Value = txtInput(3).innerText

Set txtInput(4) = txtInput(3).parentElement.getElementsByTagName(“span”)(0)
Cells(i + 3, 5).Value = txtInput(4).innerText

On Error GoTo 0

’IE終了
IE.Quit
i = i + 1
Loop

End Sub

動作について

上記のVBAを実行した際の画面を動画で載せておきます。
自動でInternetExplorerが起動し、Yahoo地図のページから順に情報を抽出します。
※地図は読み込まない設定にしています。


おすすめ書籍 (広告)

コメント

  1. 工藤 より:

    お疲れ様です。コードを入れて実行すると、エラー424 オブジェクトが必要ですとなりますが、何故でしょう?

    • okumasahito より:

      サイトが更新されていてVBAで取得することになっている要素がなくなっております。
      公開しているコードは現在動作しないと思います。
      よろしくお願いします。