VBA SDKを使って、経路探索結果で「早・安・楽」の判定をする

本記事はヴァル研究所の支援として作成された記事です

駅すぱあとはAPIを公開しており、駅情報や経路探索などをAPI経由で行えます。メソッドはすべてGETメソッドで、情報取得系のみです。レスポンスはJSONまたはXMLで返ってきます。

この駅すぱあと APIを利用しやすくするSDKを開発しています。SDKはVBAとPythonで開発していますが、どちらも非公式SDKなので、公式への問い合わせはご遠慮ください。

今回は、VBA SDKを使って、経路探索結果を「早・安・楽」の判定をする方法を解説します。「駅すぱあと API」では、判定結果を返す機能は存在していないため、 アプリケーション側で判定を行う実装を行う必要があります。EkispertAPIMania/VBA-SDK: Excel VBAなどで動作する駅すぱあと VBA SDKです（Windowsのみ）の実践的な使い方として、参考にしてください。

利用している機能

このデモでは、SDKの以下の機能を使っています。

• 経路探索

セットアップ

Releases · EkispertAPIMania/VBA-SDKにて公開しているExcelファイルをダウンロードするか、リポジトリをクローンした上でvbaidiot/ariawaseを使ってコンパイルします。

git clone https://github.com/vbaidiot/ariawase.git
cd ariawase
mkdir src

この src の中にSDKのリポジトリをクローンします。名前は Ekispert.xlsm です。

git clone https://github.com/EkispertAPIMania/VBA-SDK.git Ekispert.xlsm

そして、ariawase ディレクトリに移動して、以下のコマンドを実行します。

cd ..
cscript vbac.wsf combine

そうすると bin ディレクトリの中に Ekispert.xlsm が生成されます。このファイルの中に、SDKのコードが入っています。

Excelファイルの作成とSDKのインストール

新しいExcelファイルをマクロの有効なファイルとして作成します（.xlsmファイルになります）。開発メニューを開いて、Visual Basicを選択します。

一緒に、先ほど作成した（またはダウンロードした）SDKのExcelファイルを開きます。標準モジュール、クラスモジュールをすべてコピー（ドラッグ&ドロップ）してください。

これで、ExcelファイルにSDKが組み込まれました。

コードの解説

関数の用意

今回は CalcurateFee という関数を作成します。

Sub CalcurateFee()
    ' ここにコードを書く
End Sub

出力先シートの準備

Sheet1 に出力します。以下のように、A1からD1までに見出しを入れておきます。

VBA側でも、このシートのオブジェクトを用意します。

Set ws = ThisWorkbook.Sheets("Sheet1")
ws.Activate

SDKの初期化

VBA SDKを初期化します。APIキーは、自分のものと置き換えてください。

Dim client As Ekispert
Set client = New Ekispert
client.apiKey = "YOUR_API_KEY"

経路探索を行う

経路探索を行います。今回は「東京」から「八王子」までの経路を探索します。経路探索は、 CourseExtremeQuery を使います。最大探索数(searchCountパラメータ)と最大回答数(answerCountパラメータ)を多くすることで、多くの選択肢（経路）を取得できます。

Dim Query As CourseExtremeQuery
Set Query = client.CourseExtremeQuery()

Query.ViaList(0) = "東京"
Query.ViaList(1) = "八王子"
Query.SearchCount = 20
Query.AnswerCount = 20
Query.Sort = Price ' 運賃順
Query.Sort = Time ' 時間順
Query.Sort = Transfer ' 乗り換え回数順

実行結果を取得して、エラーの場合はエラーメッセージを出して終了します。

Dim Result As ResultSet
Result = Query.Find()
If Result.Success = False Then
        Debug.Print Result.Error.Message
        Exit Sub
End If

結果の取得

探索結果を、以下のような構造体に入れていきます。これは標準モジュールを新しく作成して、その中に作成します。

Type RouteResult
    TimeOnBoard As Integer   ' 乗車時間
    Fee As Integer           ' 運賃
    TransferCount As Integer ' 乗り換え回数
    Route As String          ' 経路
End Type

' 探索結果を入れる配列
Dim RouteResults() As RouteResult
' 結果の数だけ配列を確保
ReDim RouteResults(UBound(Result.Courses)) As RouteResult

For i = 0 To UBound(Result.Courses)
    Dim RouteResult As RouteResult
    ' 結果をRouteResultに入れる
    RouteResult.TimeOnBoard = Result.Courses(i).Route.TimeOnBoard ' 乗車時間
    RouteResult.Fee = GetFee(Result.Courses(i).Prices)            ' 運賃
    RouteResult.TransferCount = Result.Courses(i).Route.TransferCount ' 乗り換え回数
    ' 経路を取得
    Dim Route() As String
    ' 経路の数だけ配列を確保（到着駅は除く）
    ReDim Route(UBound(Result.Courses(i).Route.Points) - 1) As String
    For j = 0 To UBound(Result.Courses(i).Route.Points) - 1
        Dim DepartureStationName As String    ' 出発駅名
        Dim DestinationStationName As String  ' 到着駅名
        Dim LineName As String                ' 路線名
        ' 出発駅名、到着駅名、路線名を取得
        DepartureStationName = Result.Courses(i).Route.Points(j).Station.Name
        DestinationStationName = Result.Courses(i).Route.Points(j + 1).Station.Name
        LineName = Result.Courses(i).Route.Lines(j).Name
        ' 経路を作成
        Route(j) = DepartureStationName & " (" & LineName & ") " & DestinationStationName
    Next j
    ' 経路を改行つなぎで結合
    RouteResult.Route = Join(Route, vbCrLf)
    ' 結果を配列に格納
    RouteResults(i) = RouteResult
Next i

GetFee関数は、運賃を取得するための関数です。運賃は、 Prices の中に入っています。有料特急や新幹線など、運賃と別に料金が発生する経路の場合は ChargeSummary を考慮する必要があります。 FareSummary と ChargeSummary を足して、ソートに利用します。

Function GetFee(ByRef Prices() As Price) As Integer
    Dim FareSummary As Integer
    Dim ChargeSummary As Integer
    For i = 0 To UBound(Prices)
        If Prices(i).Kind = "FareSummary" Then
            FareSummary = Prices(i).Oneway
        End If
        If Prices(i).Kind = "ChargeSummary" Then
            ChargeSummary = Prices(i).Oneway
        End If
    Next i
    GetFee = FareSummary + ChargeSummary
End Function

結果の出力

後は、結果を出力するだけです。

For i = 0 To UBound(RouteResults)
    ws.Cells(i + 3, 1).value = RouteResults(i).TimeOnBoard
    ws.Cells(i + 3, 2).value = RouteResults(i).Fee
    ws.Cells(i + 3, 3).value = RouteResults(i).TransferCount
    ws.Cells(i + 3, 4).value = RouteResults(i).Route
Next i

ソートを実装する

上記の実行方法の場合、早い順・安い順・楽な順を取得しようと思うと、3回APIリクエストが必要になります。それはAPIコール数が勿体ないので、VBA側でソートを実装してみました。これは簡易的なバブルソートです。乗車時間、運賃、乗り換え回数のいずれかを指定してソートします。

Sub BubbleSort(arr() As RouteResult, key As String)
    Dim i As Long, j As Long
    Dim temp As RouteResult
    Dim val1 As Integer
    Dim val2 As Integer
    For i = LBound(arr) To UBound(arr) - 1
        For j = i + 1 To UBound(arr)
            Select Case key
            Case "TimeOnBoard"
                val1 = arr(i).TimeOnBoard
                val2 = arr(j).TimeOnBoard
            Case "Fee"
                val1 = arr(i).Fee
                val2 = arr(j).Fee
            Case "TransferCount"
                val1 = arr(i).TransferCount
                val2 = arr(j).TransferCount
            End Select
            If val1 > val2 Then
                temp = arr(i)
                arr(i) = arr(j)
                arr(j) = temp
            End If
        Next j
    Next i
End Sub

この関数は、以下のように使います。

' 早い順
BubbleSort RouteResults, "TimeOnBoard"
' 安い順
BubbleSort RouteResults, "Fee"
' 乗り換え回数順
BubbleSort RouteResults, "TransferCount"

出力する

ソートした結果を、 シートに出力します。一番上の結果が、それぞれの「早・安・楽」のデータになります。

' 早い順
BubbleSort RouteResults, "TimeOnBoard"
For i = 0 To UBound(RouteResults)
    ws.Cells(i + 3, 1).value = RouteResults(i).TimeOnBoard
    ws.Cells(i + 3, 2).value = RouteResults(i).Fee
    ws.Cells(i + 3, 3).value = RouteResults(i).TransferCount
    ws.Cells(i + 3, 4).value = RouteResults(i).Route
Next i

' 乗り換え回数順
BubbleSort RouteResults, "TransferCount"
For i = 0 To UBound(RouteResults)
    ws.Cells(i + 3, 6).value = RouteResults(i).TimeOnBoard
    ws.Cells(i + 3, 7).value = RouteResults(i).Fee
    ws.Cells(i + 3, 8).value = RouteResults(i).TransferCount
    ws.Cells(i + 3, 9).value = RouteResults(i).Route
Next i

' 安い順
BubbleSort RouteResults, "Fee"
For i = 0 To UBound(RouteResults)
    ws.Cells(i + 3, 11).value = RouteResults(i).TimeOnBoard
    ws.Cells(i + 3, 12).value = RouteResults(i).Fee
    ws.Cells(i + 3, 13).value = RouteResults(i).TransferCount
    ws.Cells(i + 3, 14).value = RouteResults(i).Route
Next i

結果は正しく出ているようです。

全体のコード

全体のコードは以下のようになります。

' 経路情報を取得して、時間・乗換・料金でソートしてExcelに出力するマクロ
Sub CalcurateFee()
    ' シート「Sheet1」を取得してアクティブにする
    Set ws = ThisWorkbook.Sheets("Sheet1")
    ws.Activate

    ' Ekispertのクライアントオブジェクトを生成し、APIキーを設定
    Dim client As Ekispert
    Set client = New Ekispert
    client.apiKey = "YOUR_API_KEY" ' ←ここに取得したAPIキーを入力してください

    ' 経路検索用のクエリオブジェクトを作成
    Dim Query As CourseExtremeQuery
    Set Query = client.CourseExtremeQuery()
    
    ' 出発地と経由地を設定（ViaListに順番に入れる）
    Query.ViaList(0) = "東京"
    Query.ViaList(1) = "八王子"

    ' 最大で20件の検索結果を取得
    Query.SearchCount = 20
    Query.AnswerCount = 20

    ' 検索結果を料金の安い順でソート
    Query.Sort = Price

    ' 検索を実行して結果を取得
    Dim Result As ResultSet
    Result = Query.Find()

    ' 結果が失敗だった場合はエラーメッセージを表示して終了
    If Result.Success = False Then
        Debug.Print Result.Error.Message
        Exit Sub
    End If

    ' 結果を格納する配列を準備（要素数は取得した経路数と同じ）
    Dim RouteResults() As RouteResult
    ReDim RouteResults(UBound(Result.Courses)) As RouteResult

    ' 各経路の情報を1件ずつ処理
    For i = 0 To UBound(Result.Courses)
        Dim RouteResult As RouteResult

        ' 所要時間、料金、乗換回数を取得
        RouteResult.TimeOnBoard = Result.Courses(i).Route.TimeOnBoard     ' 乗車時間
        RouteResult.Fee = GetFee(Result.Courses(i).Prices)                ' 運賃
        RouteResult.TransferCount = Result.Courses(i).Route.TransferCount ' 乗換回数

        ' 経路の駅名と路線名を文字列としてまとめる
        Dim Route() As String
        ReDim Route(UBound(Result.Courses(i).Route.Points) - 1) As String
        ' 経路の駅数分ループ
        ' 最後の駅は到着駅なので、1つ前までループ
        For j = 0 To UBound(Result.Courses(i).Route.Points) - 1
            Dim DepartureStationName As String
            Dim DestinationStationName As String
            Dim LineName As String

            DepartureStationName = Result.Courses(i).Route.Points(j).Station.Name ' 出発駅名
            DestinationStationName = Result.Courses(i).Route.Points(j + 1).Station.Name ' 到着駅名
            LineName = Result.Courses(i).Route.Lines(j).Name ' 路線名

            ' 「出発駅（路線名）到着駅」の形式で記述
            Route(j) = DepartureStationName & " (" & LineName & ") " & DestinationStationName
        Next j

        ' 経路全体を改行でつなげて格納
        RouteResult.Route = Join(Route, vbCrLf)

        ' 配列に追加
        RouteResults(i) = RouteResult
    Next i

    ' ===== 以下、3つの観点で並べ替えてシートに出力 =====

    ' 所要時間順にソートして出力（列A〜D）
    BubbleSort RouteResults, "TimeOnBoard"
    For i = 0 To UBound(RouteResults)
        ws.Cells(i + 3, 1).value = RouteResults(i).TimeOnBoard
        ws.Cells(i + 3, 2).value = RouteResults(i).Fee
        ws.Cells(i + 3, 3).value = RouteResults(i).TransferCount
        ws.Cells(i + 3, 4).value = RouteResults(i).Route
    Next i

    ' 乗換回数順にソートして出力（列F〜I）
    BubbleSort RouteResults, "TransferCount"
    For i = 0 To UBound(RouteResults)
        ws.Cells(i + 3, 6).value = RouteResults(i).TimeOnBoard
        ws.Cells(i + 3, 7).value = RouteResults(i).Fee
        ws.Cells(i + 3, 8).value = RouteResults(i).TransferCount
        ws.Cells(i + 3, 9).value = RouteResults(i).Route
    Next i

    ' 料金順にソートして出力（列K〜N）
    BubbleSort RouteResults, "Fee"
    For i = 0 To UBound(RouteResults)
        ws.Cells(i + 3, 11).value = RouteResults(i).TimeOnBoard
        ws.Cells(i + 3, 12).value = RouteResults(i).Fee
        ws.Cells(i + 3, 13).value = RouteResults(i).TransferCount
        ws.Cells(i + 3, 14).value = RouteResults(i).Route
    Next i
End Sub

' バブルソートで配列を並び替える関数（keyの項目で昇順ソート）
Sub BubbleSort(arr() As RouteResult, key As String)
    Dim i As Long, j As Long
    Dim temp As RouteResult
    Dim val1 As Integer
    Dim val2 As Integer

    For i = LBound(arr) To UBound(arr) - 1
        For j = i + 1 To UBound(arr)
            Select Case key
                Case "TimeOnBoard"
                    val1 = arr(i).TimeOnBoard
                    val2 = arr(j).TimeOnBoard
                Case "Fee"
                    val1 = arr(i).Fee
                    val2 = arr(j).Fee
                Case "TransferCount"
                    val1 = arr(i).TransferCount
                    val2 = arr(j).TransferCount
            End Select

            ' 値が大きい方を後ろに移動（昇順）
            If val1 > val2 Then
                temp = arr(i)
                arr(i) = arr(j)
                arr(j) = temp
            End If
        Next j
    Next i
End Sub

' 料金情報から適切な金額（運賃と料金を足した金額）を取得
Function GetFee(ByRef Prices() As Price) As Integer
    Dim FareSummary As Integer
    Dim ChargeSummary As Integer

    ' 各料金タイプを確認
    For i = 0 To UBound(Prices)
        If Prices(i).Kind = "FareSummary" Then
            FareSummary = Prices(i).Oneway
        End If
        If Prices(i).Kind = "ChargeSummary" Then
            ChargeSummary = Prices(i).Oneway
        End If
    Next i

    ' 高い方を採用
    GetFee = FareSummary + ChargeSummary
End Function

まとめ

単に経路探索といっても、乗り換え回数や料金などさまざまなニーズがあります。駅すぱあとAPIを使えば、そうした条件に応じた経路探索が簡単にできますので、ぜひ活用してください。

さらにVBA SDKを使えば、Excel上で簡単に駅すぱあとAPIを利用できます。ぜひ試してみてください。

EkispertAPIMania/VBA-SDK: Excel VBAなどで動作する駅すぱあと VBA SDKです（Windowsのみ）