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
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地図のページから順に情報を抽出します。
※地図は読み込まない設定にしています。
おすすめ書籍 (広告)
Amazon 楽天 Yahoo検索 |
---|
Amazon 価格:¥1,603円 |
bookfan 1号店 楽天市場店 価格:2,530円 |
bookfan 1号店 楽天市場店 価格:2,530円 |
bookfanプレミアム 価格:2,530円 |
ぐるぐる王国 ヤフー店 価格:2,530円 |
コメント
お疲れ様です。コードを入れて実行すると、エラー424 オブジェクトが必要ですとなりますが、何故でしょう?
サイトが更新されていてVBAで取得することになっている要素がなくなっております。
公開しているコードは現在動作しないと思います。
よろしくお願いします。