複数経路の時間を一括で調べるExcelVBA

乗り換え検索をより素早くできるように改良した
検索結果を示すURLには検索に使用する要素（出発地と目的地など）が含まれている
Excelのシート上に上記の条件分岐を行うための表を作成する
条件分岐を反映させて乗り換え検索をするVBAコード

乗り換え検索をより素早くできるように改良した

以前複数の電車での移動時間を自動で調べるExcelVBAを作成しましたが、私の会社のPCでうまく動かなかった（多分プロキシサーバーを介していて、しかもそのサーバーの調子が悪いことが原因と思います。）のでより手軽にしっかりと検索できる仕組みを考えてみました。

検索結果を示すURLには検索に使用する要素（出発地と目的地など）が含まれている

ショッピングや調べ物の検索ではよくあることですが、表示されるページのURLには検索語句が含まれています。

乗り換え検索でも結果が表示されるページのURLには検索結果が含まれているのでそれを利用してVBAで検索結果のページに直接アクセスする方法を考えました。

例えば東京から大阪に移動する乗り換え検索の結果ページのURL(日付指定なし)は以下のようになります。

https://transit.yahoo.co.jp/search/result?flatlon=&from= %E6%9D%B1%E4%BA%AC&tlatlon=&to=%E5%A4%A7%E9%98%AA&
via=&via=&via=&y=2017&m=08&d=04&hh=00&m2=0&m1=0&type=5&ticket=ic&
al=1&shin=1&ex=1&hb=1&lb=1&sr=1&s=0&expkind=1&ws=3&
kw=%E5%A4%A7%E9%98%AA

「&from=」に続く赤に記した「E6%9D%B1%E4%BA%AC」が「東京」を指します。
これはURLが日本語を表示できないため、置き換えられた文字になります（URLエンコード）。

この文字はExcelのワークシート関数を使って表すことができ、「=ENCODEURL(“東京”)」とセルに入力すると上記の置き換えられた文字が表示されます。
同様に「&to=」に続く「%E5%A4%A7%E9%98%AA」は「大阪」を示します。
以下のように検索で指定した要素がすべてこのURLの中に網羅されています。

“&y=”	検索年	対象年月日を入力
“&m=”	検索月
“&d=”	検索日
“&hh=”	検索時間	対象時間を入力
“&m2=”	検索分（1の位）
“&m1=”	検索分（10の位）
“&type=”	検索の種類	“1”で出発時間検索 “2”で終電検索 “3”で始発検索 “4”で到着時間検索 “5”で指定なし
“&ticket=”	IC優先かどうか	“ic”でIC優先	今回は条件分岐なし
“&al=”	飛行機	“1”で使用する “0”で使用しない
“&shin=”	新幹線	“1”で使用する “0”で使用しない
“&ex=”	有料特急	“1”で使用する “0”で使用しない
“&hb=”	高速バス	“1”で使用する “0”で使用しない
“&lb=”	路線バス	“1”で使用する “0”で使用しない
“&sr=”	フェリー	“1”で使用する “0”で使用しない
“&s=”	結果の表示順	“0”で到着が早い順 “1”で料金が安い順 “2”で乗り換え回数順
“&expkind=”	自由席優先	“1”で自由席優先	今回は条件分岐なし
“&ws=”	歩くの少しゆっくり	“3”で歩くの少しゆっくり	今回は条件分岐なし

Excelのシート上に上記の条件分岐を行うための表を作成する

前回の場合と同様にExcelのシート上にこれらの要素を入力しておいて、条件に沿ったURLを表示するために条件分岐を行います。

条件分岐を反映させて乗り換え検索をするVBAコード

複数の乗り換え検索を自動で調べるVBAコードは以下のようになります。

Option Explicit
Dim IE As Object
Dim txtInput(16) As Object
Declare Sub Sleep Lib “kernel32” (ByVal dwMilliseconds As Long)

Sub 乗り換え検索2()

Dim 出発() As String
Dim 到着() As String
Dim 検索タイプ() As String
Dim 日付() As Date
Dim 時間() As Date
Dim 飛行機() As String
Dim 新幹線() As String
Dim 有料特急() As String
Dim 高速バス() As String
Dim 路線バス() As String
Dim フェリー() As String
Dim 検索結果の表示順() As String

Dim URL() As String

Dim i As Long
i = 0
For i = 0 To 10

ReDim Preserve 出発(i) As String
ReDim Preserve 到着(i) As String
ReDim Preserve 検索タイプ(i) As String
ReDim Preserve 日付(i) As Date
ReDim Preserve 時間(i) As Date
ReDim Preserve 飛行機(i) As String
ReDim Preserve 新幹線(i) As String
ReDim Preserve 有料特急(i) As String
ReDim Preserve 高速バス(i) As String
ReDim Preserve 路線バス(i) As String
ReDim Preserve フェリー(i) As String
ReDim Preserve 検索結果の表示順(i) As String

ReDim Preserve URL(i) As String

出発(i) = Cells(i + 4, 3)
到着(i) = Cells(i + 4, 4)

Select Case Cells(i + 4, 5)
Case Is = “出発”
検索タイプ(i) = “1”
Case Is = “到着”
検索タイプ(i) = “4”
Case Is = “始発”
検索タイプ(i) = “3”
Case Is = “終電”
検索タイプ(i) = “2”
Case Is = “指定なし”
検索タイプ(i) = “5”
Case Else
検索タイプ(i) = “5”
End Select

If Cells(i + 4, 6) <> “” Then
日付(i) = Cells(i + 4, 6)
Else
日付(i) = Date
End If

If Cells(i + 4, 7) <> “” Then
時間(i) = Cells(i + 4, 7)
Else
時間(i) = “9:00”
End If

If Cells(i + 4, 8) <> “” Then
飛行機(i) = “1”
Else
飛行機(i) = “0”
End If

If Cells(i + 4, 9) <> “” Then
新幹線(i) = “1”
Else
新幹線(i) = “0”
End If

If Cells(i + 4, 10) <> “” Then
有料特急(i) = “1”
Else
有料特急(i) = “0”
End If

If Cells(i + 4, 11) <> “” Then
高速バス(i) = “1”
Else
高速バス(i) = “0”
End If

If Cells(i + 4, 12) <> “” Then
路線バス(i) = “1”
Else
路線バス(i) = “0”
End If

If Cells(i + 4, 13) <> “” Then
フェリー(i) = “1”
Else
フェリー(i) = “0”
End If

Select Case Cells(i + 4, 14)
Case Is = “到着が早い順”
検索結果の表示順(i) = “0”
Case Is = “料金が安い順”
検索結果の表示順(i) = “1”
Case Is = “乗り換え回数順”
検索結果の表示順(i) = “2”
Case Else

End Select

URL(i) = “https://transit.yahoo.co.jp/search/result?flatlon=&” & _
“from=” & Application.WorksheetFunction.EncodeURL(出発(i)) & _
“&tlatlon=” & _
“&to=” & Application.WorksheetFunction.EncodeURL(到着(i)) & _
“&via=&via=&via=” & _
“&y=” & Format(Year(日付(i)), “0000”) & _
“&m=” & Format(Month(日付(i)), “00”) & _
“&d=” & Format(Day(日付(i)), “00”) & _
“&hh=” & Format(Hour(時間(i)), “00”) & _
“&m2=” & Right(Format(Minute(時間(i)), “00”), 1) & _
“&m1=” & Left(Format(Minute(時間(i)), “00”), 1) & _
“&type=” & 検索タイプ(i) & _
“&ticket=” & “ic” & _
“&al=” & 飛行機(i) & _
“&shin=” & 新幹線(i) & _
“&ex=” & 有料特急(i) & _
“&hb=” & 高速バス(i) & _
“&lb=” & 路線バス(i) & _
“&sr=” & フェリー(i) & _
“&s=” & 検索結果の表示順(i) & _
“&expkind=” & “1” & “&ws=” & “3” ’自由席優先で歩くの少しゆっくり

’IE立上げ

Set IE = CreateObject(“InternetExplorer.application”)
IE.Visible = True
IE.navigate (URL(i))

Do While IE.Busy Or IE.readyState <> READYSTATE_COMPLETE
DoEvents
Sleep 1
Loop
Sleep 500

’乗り換え案内結果集計

Set txtInput(0) = IE.document.getElementsByClassName(“time”)(0)
Cells(i + 4, 15).Value = txtInput(0).innerText

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

Set txtInput(2) = IE.document.getElementsByClassName(“fare”)(0)
Cells(i + 4, 17).Value = txtInput(2).innerText

Set txtInput(3) = IE.document.getElementsByClassName(“time”)(2)
Cells(i + 4, 18).Value = txtInput(3).innerText

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

Set txtInput(5) = IE.document.getElementsByClassName(“time”)(3)
Cells(i + 4, 20).Value = txtInput(5).innerText

Set txtInput(6) = IE.document.getElementsByClassName(“fare”)(2)
Cells(i + 4, 21).Value = txtInput(6).innerText

’IE終了

IE.Quit

Next i

End Sub

このコードを実行すると以下の動画のようにExcelの表に記載されている出発地点から到着地点までの時間を簡単に一覧にすることができます。

有料のapiなどを使えばもっと素早くデータを作成できるはずですが、あくまで無料の範囲でできることを考えてみました。
またより良い方法があれば紹介させていただきます。

おすすめ書籍 (広告)

Amazon 楽天 Yahoo検索
Amazon 価格：￥1,603円
bookfan 1号店楽天市場店価格：2,530円
bookfan 1号店楽天市場店価格：2,530円
bookfanプレミアム価格：2,530円
VALUE BOOKS Yahoo!店価格：413円