「駅すぱあと API」をExcel VBAから利用して、経費精算用に経路探索を行う

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

今回は、「駅すぱあと API」をExcel VBAから利用して、経費精算に利用する情報を取得してみます。出発駅や経由、到着駅を選んで実行すると、ルートや運賃が表示されますので、経費精算の手間が大幅に軽減されるでしょう。

駅すぱあと APIの基本的な利用方法は前回の[経路探索の基本：経費精算を自動化する簡単な方法](https://qiita.com/goofmint/items/1c27af80709f84f1dcab)を参考にしてください。

## できあがりイメージ

今回のExcelファイルは、[こちらのリポジトリにアップロードしてあります](https://github.com/goofmint/ekispart_routes_demo)。駅すぱあとAPIのAPIキーは自分が取得したものを利用してください。

### 駅名・バス停名などの入力補完

![image1.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/197026/a7b9400c-6176-24ce-87a8-c53d9898bc2b.png)


今回は全部で4つの経路情報が入力できます。出発駅と到着駅は必須です。入力すると、駅名が入力されたセルに対して、入力補完が行われます。

- 出発駅
- 経由駅1
- 経由駅2
- 到着駅

たとえば `八王子` と入力すると、横浜に一致する駅名やバス停などが選べるようになります。これは駅簡易情報APIを利用しています。

この入力補完用データは、データシートに書き込まれます。

![image3.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/197026/380bdbcf-429c-3fbe-6f10-26f1c6968bd1.png)


### 経路検索

出発駅や経由駅を入力した後、 `ルート探索` ボタンを押すと、経路探索を実行します。これは[経路探索API](https://docs.ekispert.com/v1/api/search/course/extreme.html)を利用しています。

結果は、別のシートが作成され、そこにルート毎に横並びに表示されます。経由した駅名、路線名、そして最終的な運賃が算出されます。

![image2.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/197026/ef49f455-709d-8768-6e42-88a7dcb96cae.png)

## 実装について

### 利用したライブラリ

今回利用したライブラリは以下の通りです。

- [VBA-tools/VBA-Dictionary](https://github.com/VBA-tools/VBA-Dictionary)
- [VBA-tools/VBA-Web: VBA-Web](https://github.com/VBA-tools/VBA-Web)
- [VBA-tools/VBA-JSON](https://github.com/VBA-tools/VBA-JSON)

### 対応OSについて

今回はWindowsでのみ動作します。URLエンコード時に `WorksheetFunction.EncodeURL` を使っており、これがWindowsのみ提供されているためです。macOSでもURLエンコードできる関数があれば、macOSでも利用できるはずです（色々試したのですが駄目でした…ご存じの方、教えてください！）

### 駅名・バス停名などの入力補完機能の実装

入力補完を行う際には、 `Worksheet_Change` を利用して、セルの入力イベントをチェックします。ここで行っているのは、以下のような内容です。

1. 入力されたセルが、出発駅、経由駅1、経由駅2、到着駅のいずれかであるかをチェック
2. すでに入力補完（ドロップダウン）があり、そこからの選択であれば何もしない
3. 削除された場合は、入力補完のデータ元（データシート）も削除
4. 入力された内容で駅名を検索
5. データシートに結果を書き込み、入力補完を設定

実際のコードです。以下は、入力イベントの処理です。

```vb
Private Sub Worksheet_Change(ByVal Target As Range)
    ' 範囲外なら何もしない
    If Intersect(Target, Range("B1:B4")) Is Nothing Then
        Exit Sub
    End If
    ' 行番号
    Dim RowIndex As Integer
    RowIndex = Target.Row
    ' 行番号をアルファベットに変換
    Dim RowName As String
    RowName = Left(Cells(1, (RowIndex * 2) - 1).Address(False, False), 1)
    ' シート
    Dim sheet As Worksheet
    Set sheet = Worksheets("データ")
    ' 最終行を取得
    Dim LastRow As Integer
    LastRow = sheet.Cells(sheet.Rows.Count, 1).End(xlUp).Row
    If LastRow = 1 Then ' 何もデータがない場合は、2行目から
        LastRow = 2
    End If
    ' 選択された場合は何もしない
    If Not sheet.Range(RowName & "2:" & RowName & LastRow).Find(Target.Value) Is Nothing Then
        ' 選択された場合
        Exit Sub
    End If
    ' 駅の配列が入る構造体
    Dim Stations() As Station
    ' 駅の構造体
    Dim s As Station
    ' インデックス
    Dim i As Integer

    ' 入力値がない（削除した）場合は、入力選択を解除
    ' データシートの内容も削除
    If Target.Value = "" Then
        ' 入力選択解除
        Target.Validation.Delete
        sheet.Range(sheet.Cells(2, (RowIndex * 2) - 1), sheet.Cells(LastRow, (RowIndex * 2))).Clear
        Exit Sub
    End If

    ' データシートの入力内容を削除
    sheet.Range(sheet.Cells(2, (RowIndex * 2) - 1), sheet.Cells(LastRow, (RowIndex * 2))).Clear
    ' 駅情報を取得
    Stations = GetStations(Target.Value)
    ' 結果を描画する
    For i = 0 To UBound(Stations)
        s = Stations(i)
        sheet.Cells(i + 2, (RowIndex * 2) - 1).Value = s.Name ' 駅名
        sheet.Cells(i + 2, (RowIndex * 2)).Value = s.Code     ' 駅コード
    Next i
    ' その範囲をリスト入力にする
    With Target.Validation
       .Add Type:=xlValidateList, AlertStyle:=xlValidAlertInformation, _
            Operator:=xlBetween, Formula1:="=データ!$" & RowName & "$2:$" & RowName & "$" & UBound(Stations) + 1
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .IMEMode = xlIMEModeNoControl
        .ShowInput = True
        .ShowError = True
    End With
End Sub
```

駅名を取得するのは `GetStations` 関数になります。 `YOUR_API_KEY` は自分のAPIキーに置き換えてください。

```vb
' 駅情報の構造体
Type Station
    Name As String ' 駅名
    Code As String ' 駅コード
End Type

' 駅名を取得する関数
Function GetStations(Name As String) As Station()
    ' APIキー
    Dim ApiKey As String
    ApiKey = "YOUR_API_KEY"
    ' インデックス
    Dim i As Integer
    ' APIエンドポイント
    Dim ApiEndPoint As String
    ApiEndPoint = "https://api.ekispert.jp"
    
    ' APIパス
    Dim ApiPath As String
    ApiPath = "/v1/{format}/station/light"
    
    ' Webクライアント
    Dim Client As New WebClient
    Client.BaseUrl = ApiEndPoint
    
    ' リクエスト内容の作成
    Dim DirectionsRequest As New WebRequest
    DirectionsRequest.Method = WebMethod.HttpGet
    DirectionsRequest.AddUrlSegment "format", "json"
    Dim Query As New Dictionary
    Query.Add "key", ApiKey
    Query.Add "name", Name
    Query.Add "nameMatchType", "partial"
    Dim QueryString() As String
    ReDim QueryString(UBound(Query.Items))
    ' クエリ文字列の作成（エンコードも行う）
    For i = 0 To UBound(Query.Items)
        QueryString(i) = Query.Keys(i) & "=" & WorksheetFunction.EncodeURL(Query.Item(Query.Keys(i)))
    Next i
    DirectionsRequest.Resource = ApiPath & "?" & Join(QueryString, "&")
    ' リクエストの実行
    Dim Response As WebResponse
    Set Response = Client.Execute(DirectionsRequest)
    ' ステータスコードが200以外の場合はエラー
    If Response.StatusCode <> WebStatusCode.Ok Then
        Exit Function
    End If
    ' 結果全体を格納するDictionary
    Dim ResultSet As Dictionary
    Set ResultSet = Response.Data("ResultSet")
    ' 駅情報を格納する配列
    Dim Stations() As Station
    ReDim Stations(ResultSet("Point").Count) As Station
    
    ' 結果を配列に入れる
    Dim Point As Dictionary
    i = 0
    For Each Point In ResultSet("Point")
        Dim s As Station
        s.Name = Point("Station")("Name")
        s.Code = Point("Station")("code")
        Stations(i) = s
        i = i + 1
    Next Point
    ' 結果を返す
    GetStations = Stations
End Function
```

APIのレスポンスについては[駅簡易情報 - 駅すぱあと API Documents 駅データ・経路検索のWebAPI](https://docs.ekispert.com/v1/api/station/light.html)を参照してください。

### 経路探索機能の実装

続いて経路探索です。ここではボタンを押されたタイミングで、 `SearchRoute` 関数が呼ばれます。

```vb
' 路線情報
Type Line
    Name As String
    Type As String
End Type

' 経路のルート情報
Type Route
    Line As Line
    Boarding As Station
    Destination As Station
End Type

' 経路情報
Type Course
    Price As Long
    Route() As Route
End Type

' 経路探索を行う
Sub SearchRoute()
    ' 経路入力シート
    Dim InputSheet As Worksheet
    Set InputSheet = Worksheets("経路入力")
    ' 入力された駅名とマッチする駅コードを格納する配列
    Dim Codes() As String
    ' インデックス
    Dim i As Integer
    ' 駅コード
    Dim Code As String
    ' 駅名
    Dim Name As String
    ' 出発駅
    Dim BoardingName As String
    ' 到着駅
    Dim DestinationName As String
    
    ' 出発駅、経路駅1、経路駅2、到着駅の4つ
    For i = 1 To 4
        ' 入力値の取得
        Name = InputSheet.Cells(i, 2).Value
        ' コードを探す
        If Name = "" Then
            ' エラーチェック
            If i = 1 Or i = 4 Then
                MsgBox ("出発駅、到着駅は必須です")
                Exit Sub
            End If
            GoTo Continue
        End If
        ' 出発駅名（結果シート名に利用する）
        If i = 1 Then
            BoardingName = Name
        End If
        ' 到着駅名（結果シート名に利用する）
        If i = 4 Then
            DestinationName = Name
        End If
        ' 駅コードを取得
        If (Not Codes) = -1 Then
            ReDim Codes(0) As String
        Else
            ReDim Preserve Codes(UBound(Codes) + 1) As String
        End If
        Code = GetCode((i * 2) - 1, Name)
        If Code = "" Then
            MsgBox (i & "行目の名前が見つかりません（" & Name & "）")
            Exit Sub
        End If
        Codes(UBound(Codes)) = Code
Continue: ' 駅名が入っていない場合
    Next i
    ' 経路探索結果が入る配列
    Dim Courses() As Course
    ' 経路探索
    Dim Course As Course
    ' 経路のルート（配列）
    Dim Routes() As Route
    ' ルート
    Dim Route As Route
    ' API検索用
    Dim viaList As String
    viaList = Join(Codes, ":")
    ' 経路探索を実行する
    Courses = GetRoutes(viaList)
    
    ' 結果シート（新しく作成する）
    Dim ResultSheet As Worksheet
    Set ResultSheet = Worksheets.Add
    ResultSheet.Name = BoardingName & "から" & DestinationName

    ' 出力先の行数
    Dim RowIndex As Long
    ' 出力先の列数
    Dim ColumnIndex As Long
    ColumnIndex = 1
    ' 経路の数だけ繰り返す
    For i = 0 To UBound(Courses) - 1
        Course = Courses(i)
        ' 結果を出力する
        RowIndex = 1
        ResultSheet.Cells(RowIndex, ColumnIndex).Value = "ルート" & i + 1
        RowIndex = RowIndex + 1
        ResultSheet.Cells(RowIndex, ColumnIndex).Value = "合計" & Course.Price & "円"
        RowIndex = RowIndex + 2
        ResultSheet.Cells(RowIndex, ColumnIndex).Value = "乗車駅"
        ResultSheet.Cells(RowIndex, ColumnIndex + 1).Value = "路線名"
        ResultSheet.Cells(RowIndex, ColumnIndex + 2).Value = "降車駅"
        RowIndex = RowIndex + 1
        ' ルートの出力
        Routes = Course.Route
        Dim j As Long
        For j = 0 To UBound(Routes) - 1
            Route = Routes(j)
            ResultSheet.Cells(RowIndex, ColumnIndex).Value = Route.Boarding.Name
            ResultSheet.Cells(RowIndex, ColumnIndex + 1).Value = Route.Line.Name
            ResultSheet.Cells(RowIndex, ColumnIndex + 2).Value = Route.Destination.Name
            RowIndex = RowIndex + 1
        Next j
        ' 列を4つずつずらす
        ColumnIndex = ColumnIndex + 4
    Next i
End Sub
```

`GetCode` 関数は、データシートを使って、駅名と駅コードを変換します。

```vb
' 駅名から駅コードを取得する
Function GetCode(ColumnIndex As Integer, Name As String) As String
    Dim DataSheet As Worksheet
    Set DataSheet = Worksheets("データ") ' 経路入力
    ' 最終行を取得
    Dim LastRow As Integer
    LastRow = DataSheet.Cells(DataSheet.Rows.Count, 1).End(xlUp).Row
    If LastRow = 1 Then ' 何もデータがない場合
        LastRow = 2
    End If
    ' 駅名が一致する行を探す
    Dim Range As Range
    Set Range = DataSheet.Range(DataSheet.Cells(2, ColumnIndex), DataSheet.Cells(LastRow, ColumnIndex)).Find(Name, LookAt:=xlWhole)
    If Range Is Nothing Then
        ' 見つからない場合は空文字を返す
        GetCode = ""
    Else
        ' 見つかった場合は、駅コードを返す
        GetCode = DataSheet.Cells(Range.Row, Range.Column + 1).Value
    End If
End Function
```

経路探索は `GetRoutes` 関数で行います。結果は、 `Course` 構造体（配列）に格納されます。 `YOUR_API_KEY` は自分のAPIキーに置き換えてください。

```vb
' 経路探索を行う
Function GetRoutes(viaList As String) As Course()
    ' APIキー
    Dim ApiKey As String
    ApiKey = "YOUR_API_KEY"
    ' APIエンドポイント
    Dim ApiEndPoint As String
    ApiEndPoint = "https://api.ekispert.jp"
    ' APIパス
    Dim ApiPath As String
    ApiPath = "/v1/{format}/search/course/extreme"
    ' インデックス
    Dim i As Long
    ' Webクライアント
    Dim Client As New WebClient
    Client.BaseUrl = ApiEndPoint
    
    ' リクエスト内容の作成
    Dim DirectionsRequest As New WebRequest
    DirectionsRequest.Resource = ApiPath
    DirectionsRequest.Method = WebMethod.HttpGet
    DirectionsRequest.AddUrlSegment "format", "json"
    DirectionsRequest.AddQuerystringParam "key", ApiKey
    DirectionsRequest.AddQuerystringParam "viaList", viaList
    DirectionsRequest.AddQuerystringParam "searchType", “plain”
    ' リクエストの実行
    Dim Response As WebResponse
    Set Response = Client.Execute(DirectionsRequest)
    ' ステータスコードが200以外の場合はエラー
    If Response.StatusCode <> WebStatusCode.Ok Then
        Exit Function
    End If
    
    ' 結果全体を格納するDictionary
    Dim ResultSet As Dictionary
    Set ResultSet = Response.Data("ResultSet")
    ' 経路の配列
    Dim Courses() As Course
    ' 経路の数
    Dim CourseCount As Long
    CourseCount = ResultSet("Course").Count
    ReDim Courses(CourseCount) As Course
    ' インデックス
    Dim Index As Long

    ' 結果をDictinaryの配列に入れる
    Dim cs() As Dictionary
    SetArray cs, ResultSet, "Course"
    
    For Index = 0 To CourseCount - 1
        ' 経路情報を取得
        Dim Course As Dictionary
        Set Course = cs(Index)
        ' 経路情報を入れる構造体
        Dim c As Course
        ' 運賃情報
        Dim Prices() As Dictionary
        SetArray Prices, Course, "Price"
        ' 運賃を取得
        c.Price = GetPrice(Prices)
        
        ' ルート情報
        Dim Route As Dictionary
        Set Route = Course("Route")
        Dim Points() As Dictionary
        Dim Lines() As Dictionary
        ' ルートの駅情報を取得
        SetArray Points, Route, "Point"
        ' ルートの路線情報を取得
        SetArray Lines, Route, "Line"
        ' ルート情報を入れる配列
        Dim Routes() As Route
        ' 路線の数
        Dim LineCount As Long
        LineCount = UBound(Lines)
        ReDim Routes(LineCount) As Route

        ' 路線の数だけ繰り返す
        i = 0
        For i = 0 To LineCount - 1
            ' 路線情報
            Dim r As Route
            ' 駅情報
            Dim s As Dictionary
            ' 駅情報を取得
            Dim p As Dictionary
            ' 路線情報を取得
            r.Line = GetLine(Lines(i))
            
            ' 乗車駅
            If i = 0 Then
                ' 最初の駅は出発駅
                r.Boarding = GetStation(Points(i)("Station"))
            Else
                ' 2つ目以降は前の駅が乗車駅
                r.Boarding = Routes(i - 1).Destination
            End If
            
            ' 降車駅
            r.Destination = GetStation(Points(i + 1)("Station"))
            Routes(i) = r
        Next i
        c.Route = Routes
        Courses(Index) = c
    Next Index
    GetRoutes = Courses
End Function
```

`SetArray` 関数は、Dictionaryになっているデータからキーを指定して、配列にして返します。駅すぱあとAPIでは、結果が1件しかない場合はデータが配列になっていないため、その場合は配列に変換しています。

```vb
' Dictionaryを配列に変換する
Sub SetArray(ByRef ary() As Dictionary, Data As Dictionary, Key As String)
On Error GoTo NotArray
    Dim Index As Long
    ReDim ary(Data(Key).Count) As Dictionary
    Dim Params As Dictionary
    ' 配列でない場合は、ここでエラー
    For Each Params In Data(Key)
        ' 配列の場合は順次データを入れ直す
        Set ary(Index) = Params
        Index = Index + 1
    Next Params
    Exit Sub
NotArray:
    ' 配列じゃない場合
    ReDim ary(1) As Dictionary
    Set ary(0) = Data(Key)
End Sub
```

`GetLine` 関数は、路線情報を取得・返却します。

```vb
Function GetLine(Params As Dictionary) As Line
    Dim Line As Line
    Line.Name = Params("Name")
    GetLine = Line
End Function
```

`GetStation` 関数は、駅情報を取得・返却します。

```vb
Function GetStation(Params As Dictionary) As Station
    Dim Station As Station
    Station.Code = Params("code")
    Station.Name = Params("Name")
    GetStation = Station
End Function
```

`GetPrice` 関数は、運賃情報を取得・返却します。今回は通常運賃のみですが、他にも定期（1〜12ヶ月）の運賃情報なども取得できます。新幹線などを利用した場合は、取得が異なるので注意してください（詳しくは経路探索 - 駅すぱあと API Documents 駅データ・経路検索のWebAPIにて確認してください）。


```vb
Function GetPrice(Prices() As Dictionary) As Long
    Dim Price As Variant
    Dim Index As Long
    Index = UBound(Prices)
    Dim i As Long
    For i = 0 To Index
        Set Price = Prices(i)
        If Price("kind") = "FareSummary" Then
            GetPrice = Val(Price("Oneway"))
            Exit Function
        End If
    Next i
    GetPrice = 0
End Function
```

## コードについて

今回のコードは[goofmint/ekispart\_routes\_demo](https://github.com/goofmint/ekispart_routes_demo)にアップロードしてあります。実装時の参考にしてください。

## まとめ

今回は「駅すぱあと API」を使って、VBAから経路探索および運賃の算出を試しました。経路探索の他にも、「駅すぱあと API」には様々な機能があります。ぜひ、自分のアプリケーションや基幹システムに組み込んで、業務効率化を実現してください。

[駅すぱあと API Documents 駅データ・経路検索のWebAPI](https://docs.ekispert.com/v1/?utm_source=official&utm_medium=website&utm_campaign=ews_official)