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

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

[駅すぱあとはAPIを公開](https://api-info.ekispert.com/?utm_source=qiita&utm_medium=referral&utm_campaign=api-column&utm_id=202504-2)しており、駅情報や経路探索などをAPI経由で行えます。メソッドはすべてGETメソッドで、情報取得系のみです。レスポンスはJSONまたはXMLで返ってきます。

この駅すぱあと APIを利用しやすくするSDKを開発しています。SDKは[VBA](https://github.com/EkispertAPIMania/VBA-SDK)と[Python](https://github.com/EkispertAPIMania/python-sdk)で開発していますが、どちらも非公式SDKなので、公式への問い合わせはご遠慮ください。

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

## 利用している機能

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

- [経路探索](https://docs.ekispert.com/v1/api/search/course/extreme.html?utm_source=qiita&utm_medium=referral&utm_campaign=api-column&utm_id=202504-2)

![image1.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/197026/d5f5b304-c998-40c0-97ea-6837b12dc0fb.png)


## セットアップ

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

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

この `src` の中に[SDKのリポジトリ](https://github.com/EkispertAPIMania/VBA-SDK)をクローンします。名前は `Ekispert.xlsm` です。

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

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

```bash
cd ..
cscript vbac.wsf combine
```

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

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

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

![image4.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/197026/d8a79269-b524-4ecd-9e07-c1dc194cd05c.png)



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

![image5.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/197026/62647076-6cc2-4625-ab49-170a40aa7170.png)


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

## コードの解説

### 関数の用意

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

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

### 出力先シートの準備

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

![image3.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/197026/c8c4c907-9fde-4c57-ba7e-053420a2d94e.png)


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

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

### SDKの初期化

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

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

## 経路探索を行う

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

```vb
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 ' 乗り換え回数順
```

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

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

### 結果の取得

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

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

```vb
' 探索結果を入れる配列
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` を足して、ソートに利用します。

```vb
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
```

### 結果の出力

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

```vb
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側でソートを実装してみました。これは簡易的なバブルソートです。乗車時間、運賃、乗り換え回数のいずれかを指定してソートします。

```vb
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
```

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

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

### 出力する

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

```vb
' 早い順
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
```

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

![image2.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/197026/d4d20e69-b1e5-46f8-a099-5d6b10e290b5.png)


## 全体のコード

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

```vb
' 経路情報を取得して、時間・乗換・料金でソートして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のみ）](https://github.com/EkispertAPIMania/VBA-SDK)