Yahoo乗り換え検索を使って複数人の移動時間を調べるVBAコード

2017.03.20
スポンサーリンク

たくさん調べるのが大変な乗り換え検索

会社で移動時間を調べるシステムなどがある場合は必要ないですが、私の勤めている会社は研修などの対象者に向けての案内を作る際、対象者の移動時間を個別に調べています。

私も今度教育の仕事をすることになり、研修案内を出さないといけなくなりそうなので少しでも時間を削減できるように移動時間を調べるVBAコード（マクロ）を作ってみました。

Yahoo乗り換え検索で移動時間を調べるためのExcelシート

作成したExcelのシートは以下のようになります。

C~J列で条件を定めてボタンをクリックすると、K~P列の部分に必要な情報を書きだされるように設定しています。
E列・H列・I列・J列などのように記入する内容が決まっているものに関してはリストを用意してその中から選択できるようにしておくと便利です。

スポンサーリンク

Yahoo乗り換え検索で移動時間を調べるVBAコードの手順

VBAで自動実行するプログラムの基本的な流れは以下の通りです。

  • ①InternetExplorerを開く。
  • ②Yahoo乗り換え検索のページ（”http://transit.yahoo.co.jp/”）に移動する。
  • ③出発地・目的地・時間・その他新幹線を使用するか、特急を使用するかなどの条件入力
  • ④検索ボタンをクリックする。
  • ⑤表示されたページから必要な情報を収集する。
  • ⑥②～⑤を繰り返す。
  • ⑦InternetExplorerを終了する。

    • Yahoo乗り換え検索で移動時間を調べるVBAコード

    以下が作成したVBAコードです。

    Option Explicit
    Dim colSh As Object
    Dim win As Object
    Dim strTemp As String
    Dim IE As InternetExplorer
    Dim objIE(5) As InternetExplorer
    Dim objIE2 As InternetExplorer
    Dim txtInput(16) As HTMLInputElement
    Dim txtInput2(20) As HTMLSelectElement
    Dim button(10) As HTMLInputElement
    Dim Form
    Declare Sub Sleep Lib “kernel32” (ByVal dwMilliseconds As Long)
    Sub 集計()
    Dim x As Long
    IE立ち上げ
    x = 4
    Do Until x > Cells(60000, 3).End(xlUp).Row
    乗り換え案内検索 (x)
    乗り換え案内結果集計 (x)
    IE繰り返し
    x = x + 1
    Loop
    IE終了
    End Sub
    Private Sub IE立ち上げ()
    ’①InternetExplorerを開く
    Set IE = CreateObject(“InternetExplorer.application”)
    IE.Visible = True
    ’②Yahoo乗り換え検索のページ（”http://transit.yahoo.co.jp/”）に移動する。
    IE.navigate (“http://transit.yahoo.co.jp/”)
    Do While IE.Busy Or IE.readyState <> READYSTATE_COMPLETE
    DoEvents
    Sleep 1
    Loop
    Sleep 1000
    End Sub
    Private Sub 乗り換え案内検索(i As Long)
    Set colSh = CreateObject(“Shell.Application”)
    For Each win In colSh.Windows
    If TypeName(win.document) = “HTMLDocument” Then
    If InStr(win.document.Title, “乗換案内”) > 0 Then
    Set objIE(0) = win
    Exit For
    End If
    End If
    Next
    ’③出発地・目的地・時間・その他新幹線を使用するか、特急を使用するかなどの条件入力
    ’③-1 出発地の入力
    Set txtInput(1) = objIE(0).document.getElementById(“sfrom”)
    txtInput(1).Value = Cells(i, 3).Value
    ’③-2 到着地の入力
    Set txtInput(2) = objIE(0).document.getElementById(“sto”)
    txtInput(2).Value = Cells(i, 4).Value
    ’③-3 新幹線を利用するか
    Set txtInput(3) = objIE(0).document.getElementById(“sexp”)
    If Cells(i, 8).Value = “○” Then
    txtInput(3).Checked = True
    Else
    txtInput(3).Checked = False
    End If
    ’③-4 有料特急を利用するか
    Set txtInput(4) = objIE(0).document.getElementById(“exp”)
    If Cells(i, 9).Value = “○” Then
    txtInput(4).Checked = True
    Else
    txtInput(4).Checked = False
    End If
    ’③-5 出発時間での検索
    Set txtInput(5) = objIE(0).document.getElementById(“tsDep”)
    If Cells(i, 5).Value = “出発” Then
    txtInput(5).Checked = True
    End If
    ’③-6 到着時間での検索
    Set txtInput(6) = objIE(0).document.getElementById(“tsArr”)
    If Cells(i, 5).Value = “到着” Then
    txtInput(6).Checked = True
    End If
    ’③-7 日時の入力
    Set txtInput2(0) = objIE(0).document.getElementById(“y”)
    txtInput2(0).Value = Year(Cells(i, 6))
    Set txtInput2(1) = objIE(0).document.getElementById(“m”)
    txtInput2(1).Value = Format(Month(Cells(i, 6)), “00”)
    Set txtInput2(2) = objIE(0).document.getElementById(“d”)
    txtInput2(2).Value = Format(Day(Cells(i, 6)), “00”)
    Set txtInput2(3) = objIE(0).document.getElementById(“hh”)
    txtInput2(3).Value = Format(Hour(Cells(i, 7)), “00”)
    Set txtInput2(4) = objIE(0).document.getElementById(“mm”)
    txtInput2(4).Value = Format(Minute(Cells(i, 7)), “00”)
    ’③-6 検索結果表示順の選択
    Set txtInput2(5) = objIE(0).document.getElementsByName(“s”)(0)
    If Cells(i, 10).Value = “到着が早い順” Then
    txtInput2(5).Value = “0”
    ElseIf Cells(i, 10).Value = “乗り換え回数順” Then
    txtInput2(5).Value = “2”
    ElseIf Cells(i, 10).Value = “料金が安い順” Then
    txtInput2(5).Value = “1”
    End If
    ’④検索ボタンをクリックする。
    Set Form = objIE(0).document.getElementById(“searchModuleSubmit”)
    Form.Click
    Sleep 1000
    Do While objIE(0).Busy Or objIE(0).readyState <> READYSTATE_COMPLETE
    DoEvents
    Sleep 1
    Loop

    Sleep 1000
    End Sub
    Sub 乗り換え案内結果集計(i As Long)
    Set colSh = CreateObject(“Shell.Application”)
    For Each win In colSh.Windows
    If TypeName(win.document) = “HTMLDocument” Then
    If InStr(win.document.Title, “乗換案内”) > 0 Then
    Set objIE(0) = win
    Exit For
    End If
    End If
    Next
    ’⑤表示されたページから必要な情報を収集する。
    Set txtInput(7) = objIE(0).document.getElementsByClassName(“small”)(0)
    Cells(i, 11).Value = txtInput(7).innerText
    Cells(i, 11).Value = Replace(Replace(Cells(i, 11), “（”, “”), “）”, “”)
    Set txtInput(8) = objIE(0).document.getElementsByClassName(“small”)(1)
    Cells(i, 13).Value = txtInput(8).innerText
    Cells(i, 13).Value = Replace(Replace(Cells(i, 13), “（”, “”), “）”, “”)
    Set txtInput(9) = objIE(0).document.getElementsByClassName(“small”)(2)
    Cells(i, 15).Value = txtInput(9).innerText
    Cells(i, 15).Value = Replace(Replace(Cells(i, 15), “（”, “”), “）”, “”)
    Set txtInput(10) = objIE(0).document.getElementsByClassName(“fare”)(0)
    Cells(i, 12).Value = txtInput(10).innerText
    Set txtInput(11) = objIE(0).document.getElementsByClassName(“fare”)(1)
    Cells(i, 14).Value = txtInput(11).innerText
    Set txtInput(12) = objIE(0).document.getElementsByClassName(“fare”)(2)
    Cells(i, 16).Value = txtInput(12).innerText
    End Sub
    Private Sub IE繰り返し()
    Set colSh = CreateObject(“Shell.Application”)
    For Each win In colSh.Windows
    If TypeName(win.document) = “HTMLDocument” Then
    strTemp = win.document.body.innerText
    If InStr(strTemp, “乗換案内”) > 0 Then
    Set objIE(0) = win
    Exit For
    End If
    End If
    Next
    ’⑥-1 Yahoo乗り換え検索のページ（”http://transit.yahoo.co.jp/”）に移動する。
    objIE(0).navigate (“http://transit.yahoo.co.jp/”)
    Sleep 1000
    Do While objIE(0).Busy Or objIE(0).readyState < READYSTATE_COMPLETE
    DoEvents
    Sleep 1
    Loop
    Sleep 1000
    End Sub
    Private Sub IE終了()
    Set colSh = CreateObject(“Shell.Application”)
    For Each win In colSh.Windows
    If TypeName(win.document) = “HTMLDocument” Then
    strTemp = win.document.body.innerText
    If InStr(strTemp, “乗換案内”) > 0 Then
    Set objIE(0) = win
    Exit For
    End If
    End If
    Next
    ’⑦InternetExplorerを終了する。
    objIE(0).Quit
    End Sub

    上記のコードを実行した際の動画が以下のようになります。

    このVBAコードを実行する際の注意点

    私の会社のPCでこのVBAを実行したところ、画面が正常に表示されず途中でエラーになりました。
    どうやら会社のネットワーク設定でプロキシサーバーを介して外部に接続したりする場合、きちんと動かないようです。

    おすすめ書籍 (広告)

    amazonicon Amazon rakutenicon 楽天 Yahooicon Yahoo検索
    amazoniconAmazon

    価格：￥1,603円
    rakuteniconbookfan 1号店 楽天市場店
    Excel VBAでIEを思いのままに操作できるプログラミング術／近田伸矢／植木悠二／上田寛【3000円以上送料無料】
    価格：2,530円
    rakuteniconbookfan 1号店 楽天市場店
    Excel VBAでIEを思いのままに操作できるプログラミング術／近田伸矢／植木悠二／上田寛【3000円以上送料無料】
    価格：2,530円
    Yahooiconbookfanプレミアム
    【対象日は条件達成で最大+4%】Excel VBAでIEを思いのままに操作できるプログラミング術/近田伸矢/植木悠二/上田寛
    価格：2,530円
    YahooiconVALUE BOOKS Yahoo!店
    Ｅｘｃｅｌ　ＶＢＡでＩＥを思いのままに操作できるプログラミング術 Ｅｘｃｅｌ　２０１３／２０１０／２００７／２００３ /インプレスジャパン/近田伸矢 中古
    価格：413円
    amazoniconExcel VBAでIEを思いのままに操作できるプログラミング術 Excel 2013/2010/2007/2003対応
    インプレス 近田 伸矢 植木 悠二 上田 寛
    amazonicon Amazon amazonicon Kindle
    rakutenicon 楽天市場 rakutenicon Kobo
    Yahooicon Yahoo



    スポンサーリンク

    コメント