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

スポンサーリンク

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

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

私も今度教育の仕事をすることになり、研修案内を出さないといけなくなりそうなので少しでも時間を削減できるように移動時間を調べる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検索
    スポンサーリンク

    シェアする

    • このエントリーをはてなブックマークに追加

    フォローする