野口香社会保険労務士事務所

群馬県にある社会保険労務士事務所のページです。

  • 【Selenium】Excelから路線検索で交通費を取得する【VBA】

【Selenium】Excelから路線検索で交通費を取得する【VBA】

Yahoo!知恵袋の質問から、ニーズがあるのかもしれないので紹介しておきます。

目次

質問

https://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q10277106315

初心者です。Google Chromを使っています。
エクセルで日付、出発駅、到着駅を入れるとヤフー乗り換えのサイトに飛び、そこからエクセルに料金を転記するコードを作りたいです。
色々調べて作動するところまで確認できたのですが↓、ヤフー乗り換え案内で「日付を入れて検索する」のコードが分かりません。どこに入れたらいいのかも分かりません…有識者の方教えていただけると助かります…お願いいたします。エクセルはこんな状況です↙︎
A B C D E
1 日付 出発地 到着地 片道/往復 料金
2 2023/3/12
3

(F列に乗換案内のハイパーリンクのURL)

参考サイト(といってもコピペですが…)は
https://kimoba.com/kasegu/exxcel-vba-ekispart.html を見ました。

Sub 交通費()

Dim driver As New Selenium.ChromeDriver
Dim strValue As String
Dim strValueAfter As String

Dim intCnt As Integer
Dim intDataCnt As Integer
Dim intFee As Integer

intDataCnt = Worksheets(“交通費自動算出”).Range(“A1”).End(xlDown).Row

For intCnt = 2 To intDataCnt

driver.Get Worksheets(“交通費自動算出”).Cells(intCnt, 6)

strValue = driver.FindElementByXPath(“//*[@id=””rsltlst””]/li[1]/dl/dd/ul/li[2]”).Text

strValueAfter = Replace(strValue, “円”, “”)

Select Case Cells(intCnt, 4).Text

Case “往復”
intFee = Int(strValueAfter) * 2
Case “片道”
intFee = Int(strValueAfter)
Case Else

End Select

Worksheets(“交通費自動算出”).Cells(intCnt, 5).Value = intFee
Next

driver.Close
Set driver = Nothing

MsgBox “完了しました”
End Sub

補足
交通費改定で、毎日参っています。未来の改定後の値段が知りたいため、どうしても日付を入れて検索したいのです…どうかお願いいたします。

https://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q10277106315

質問者さんが参照したサイトはこちら↓です。

https://kimoba.com/kasegu/exxcel-vba-ekispart.html

日付を見ると、2019年なので若干古いです。

回答

上記の質問に対する私の回答がこちら↓

(F列に乗換案内のハイパーリンクのURL)
とありまして、ご紹介のありましたサイトを見ると、F列には長いHyperLink関数を埋め込んでいます。

このHyperLink関数を試してみると、現在Yahoo路線で使われているURLより短く、どこか足りないようです(そのため、せっかく日付を入力してあるのにデフォルトで今日の日付しか検索結果に表示しなくなっている)

だから、F列の関数を見直せばよいと思います。

https://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q10277106315

解説

HyperLink関数を直すやり方

質問者さんが参照していた先にあるページを見ると、F列にはHyperLink関数を埋め込むようになっています。

=IF(B2=””,””,HYPERLINK(“https://transit.yahoo.co.jp/search/result?&from=”&ENCODEURL($B2)&”&to=”&ENCODEURL($C2)&”&y=”&TEXT(A2,”YYYY”)&”&m=”&TEXT(A2,”mm”)&”&d=”&TEXT(A2,”dd”)&”&lb=1&type=1&ws=3&s=1&&fl=1&tl=3ticket=ic&expkind=1″))

https://kimoba.com/kasegu/exxcel-vba-ekispart.html

これを実際にExcelのシートに当てはめてみたところ、次のようなURLとなりました。

F列に関数を埋め込む

https://transit.yahoo.co.jp/search/result?&from=%E9%AB%98%E5%B4%8E&to=%E6%9D%B1%E4%BA%AC&y=2023&m=03&d=20&lb=1&type=1&ws=3&s=1&&fl=1&tl=3ticket=ic&expkind=1

HyperLink関数で得られたURL

ところが、これをクリックしてひらいたサイトがこちら↓

3月20日を指定したはずなのに、なぜか3月17日(この実験をした日)になっています。

しかしURL部分を見ると、確かにm=03とかd=20とかの文字が見えています。

おそらくURLが正しくないんだろうなと予想をつけて、手動で正しく検索してみることにしました。

手動で日付を入れて検索してみる
正しく3月20日の検索結果が得られたところで、URLをコピペする

図のように、正しく3月20日の検索結果が得られたところで、URLをコピーして内容を確かめてみます。

https://transit.yahoo.co.jp/search/result?from=%E9%AB%98%E5%B4%8E&to=%E6%9D%B1%E4%BA%AC&fromgid=&togid=&flatlon=&tlatlon=&via=&viacode=&y=2023&m=03&d=20&hh=15&m1=3&m2=5&type=1&ticket=ic&expkind=1&userpass=1&ws=3&s=0&al=1&shin=1&ex=1&hb=1&lb=1&sr=1

正しいURL

先ほどの文字列と比べて、明らかにこちらの方が長いですね。

ということは、サイトにあったHyperLink関数が2019年当時のままで古いのではないかと思いました。

Yahoo!で仕様変更を何度もしているでしょうし、最新の仕様に合わせてHyperLink関数を直してあげればよいのではないかと思います。

私が考えたHyperLink関数はこちら↓です。

=IF(B2=””,””,HYPERLINK(“https://transit.yahoo.co.jp/search/result?&from=”&ENCODEURL($B2)&”&to=”&ENCODEURL($C2)&”&fromgid=&togid=&flatlon=&tlatlon=&via=&viacode=&y=”&TEXT(A2,”YYYY”)&”&m=”&TEXT(A2,”mm”)&”&d=”&TEXT(A2,”dd”)&”&hh=07&m1=3&m2=9&type=1&ticket=ic&expkind=1&userpass=1&ws=3&s=0&al=1&shin=1&ex=1&hb=1&lb=1&sr=1″))

修正後のHyperLink関数

適当に作ったので、いろいろ雑です＾＾；

個人で楽しむレベルならこの程度でよいと思いますが、仕事でシビアな環境で使うならもう少し汎用的になるように(時刻部分をText関数で編集するとか)修正した方がよいでしょうね。

Seleniumで全部やってしまうやり方

質問者さんの参照していたサイトでHyperLink関数を使う方法が紹介されていましたが、私なら普通に値をちまちま入力していって、検索ボタンをクリックし、検索結果を表示させるだろうなと思いました。せっかくSeleniumを使うんだし、その方が早いと思います。HyperLink関数を使う方法だと、URLの仕様を変えられたらまた修正しないといけないし。

ということで、Seleniumを使って路線検索し、交通費を取得する方法をコードにしてみました。

Option Explicit
Enum c
    日付 = 1
    発
    着
    片道往復
    交通費
    URLPATH
    摘要
End Enum
Sub GetFee()
    Const clStart As Long = 2   'データが始まる行番号
    
    Dim driver As New Selenium.ChromeDriver
    Dim stValue As String
    Dim stAfterValue As String
    
    Dim lCnt As Long
    Dim lDataCnt As Long
    Dim lFee As Long
    Dim Sh As Worksheet
    
    Set Sh = Worksheets("交通費自動算出")
    lDataCnt = Sh.Range("A1").End(xlDown).Row
    
    Dim lData As Long   '日付編集用
    
    For lCnt = clStart To lDataCnt
    
        'Excelシート上から検索対象の日付を把握
        lData = Sh.Cells(lCnt, c.日付).Value
        
        'Yahoo路線検索のトップページにアクセス
        driver.Get "https://transit.yahoo.co.jp/"
        
        '出発情報
        driver.FindElementByXPath("//*[@id=""query_input""]").Clear 'いったんクリアしておかないと追記になる
        driver.Wait 100
        driver.FindElementByXPath("//*[@id=""query_input""]").SendKeys Sh.Cells(lCnt, c.発).Value
        driver.Wait 100
        
        '到着情報
        driver.FindElementByXPath("/html/body/div[1]/div[2]/div[2]/div[2]/div[1]/div[1]/div[3]/div[2]/form/dl[2]/dd/input").Clear
        driver.Wait 100
        driver.FindElementByXPath("/html/body/div[1]/div[2]/div[2]/div[2]/div[1]/div[1]/div[3]/div[2]/form/dl[2]/dd/input").SendKeys Sh.Cells(lCnt, c.着).Value
        driver.Wait 100
        
        '日付情報
        driver.FindElementByXPath("//*[@id=""y""]").AsSelect.SelectByText Format(lData, "yyyy年")
        driver.Wait 100
        driver.FindElementByXPath("//*[@id=""m""]").AsSelect.SelectByText Format(lData, "m月")
        driver.Wait 100
        driver.FindElementByXPath("//*[@id=""d""]").AsSelect.SelectByText Format(lData, "d日")
        driver.Wait 100
        driver.FindElementByXPath("//*[@id=""searchModuleSubmit""]").Click
        driver.Wait 100
        
        stValue = driver.FindElementByXPath("//*[@id=""rsltlst""]/li[1]/dl/dd/ul/li[2]").Text
        
        stAfterValue = Replace(stValue, "円", "")
        
        Select Case Sh.Cells(lCnt, c.片道往復).Text
        
            Case "往復"
            lFee = Int(stAfterValue) * 2
            Case "片道"
            lFee = Int(stAfterValue)
            Case Else
        
        End Select
        
        Sh.Cells(lCnt, c.交通費).Value = lFee
    Next
    
    driver.Close
    Set driver = Nothing
    Set Sh = Nothing
    MsgBox "完了しました"
End Sub

冒頭のEnumはワークシートの表のヘッダ部分をコピーして、そのままワークシート上で値貼り付けかつ行と列を入れ替えるで貼り付けて作っています。こういう作り方が一番早いし、何よりカラム名を考えなくてよいので楽です。あ、スラッシュ(/)はVBAで使えないので削除しました。URLも予約語っぽいのでURLPATHと少し変えました。

出発情報と到着情報のXPathが、どちらも//*[@id=”query_input”]だったので、出発情報だけにこのXPathを使い、到着情報の方はfull XPathを使いました。

日付情報はSelectリストボックスになっているので、Seleniumの.AsSelect.SelectByTextで値を指定して設定するようにしました。

ボタンをクリックするのは.Clickです。この辺の基本的なメソッドの解説は私はしません。他のすばらしい解説サイトをご参照ください(他力本願)。

あまりにも未来の日付だと選択肢がなくてエラーになりますが、その辺のエラー制御は全く入れていません(デバッグレベルのコードです)。

driver.waitはスクレイピングの作法として入れました。

編集後記

最近Yahoo!知恵袋に寄せられる質問で、余っている質問(回答者数ゼロの質問)が、こういうスクレイピング系の質問ばかりです。

それだけスクレイピングの需要が高いのでしょうか？それとも、回答者たちがスクレイピング系を嫌っているから余っているのでしょうか？

一応ニーズが高いから質問が多いと解釈し、記事にしてみました。