駅すぱあと VBA SDKを使って、経費精算用に経路探索を行うデモを作りました

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

今回は、以前作成した[「駅すぱあと API」をExcel VBAから利用して、経費精算用に経路探索を行う \#経路検索 \- Qiita](https://qiita.com/goofmint/items/e7803d6d9dffc65c5101)の内容を、VBA SDKを使って書き直してみました。

普段Excelで経費精算の作業を行なっている場合、駅すぱあと VBA SDKを使うことで簡単に経路情報や運賃を算出することができます。

[EkispertAPIMania/VBA\-SDK: Excel VBAなどで動作する駅すぱあと VBA SDKです（Windowsのみ）](https://github.com/EkispertAPIMania/VBA-SDK)の実践的な使い方として、参考にしてください。

## コードについて

今回のデモコードは[VBA\-SDK/demo at main · EkispertAPIMania/VBA\-SDK](https://github.com/EkispertAPIMania/VBA-SDK/tree/main/demo)の中に `Route.xlsm` として保存してあります。実装時の参考にしてください。

## 利用している機能

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

- [駅簡易情報](https://docs.ekispert.com/v1/api/station/light.html?utm_source=qiita&utm_medium=referral&utm_campaign=api-column&utm_id=202502-1)
- [経路探索](https://docs.ekispert.com/v1/api/search/course/extreme.html?utm_source=qiita&utm_medium=referral&utm_campaign=api-column&utm_id=202502-1)

![image1.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/197026/b6f990a0-1736-48af-b663-e919bd01ae15.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を選択します。

![image5.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/197026/0fc98b0e-da7e-454a-bd72-b98a3355eca0.png)


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

![image3.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/197026/c3ea84c8-d962-4b5a-a0ab-bec3615c7bc7.png)


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

## シートの準備

今回は以下の2つのシートを利用します。

- 経路入力
- データ
### 経路入力シート

`経路入力` シートには、以下のように入力欄を作成します。

| A       | B   |
| ------- | --- |
| 出発駅  |     |
| 経由駅1 |     |
| 経由駅2 |     |
| 到着駅  |     |

### データシート

`データ` シートには、以下のように入力欄を作成します。

| 出発駅名 | 出発駅コード | 経由1駅名 | 経由1コード | 経由2駅名 | 経由2コード | 到着駅名 | 到着駅コード |
| -------- | ------------ | --------- | ----------- | --------- | ----------- | -------- | ------------ |
|          |              |           |             |           |             |          |              |

## APIキーの設定

新しい標準モジュールを作成して、以下のコードを貼り付けます。 `YOUR_API_KEY` の部分を、取得した駅すぱあと APIのAPIキーに置き換えてください。

```vb
Public Const ApiKey As String = "YOUR_API_KEY"
```

## 入力された値を使って、駅名を検索してドロップダウンを作成する

駅名を入力して、確定されたら `駅簡易情報` 検索を実行します。処理は `Private Sub Worksheet_Change(ByVal Target As Range)` にて実行します。

```vb
Private Sub Worksheet_Change(ByVal Target As Range)
  ' ここに処理を書く
End Sub
```

処理対象がない場合は、何もせず処理を終了します。

```vb
If Intersect(Target, Range("B1:B4")) Is Nothing Then
    Exit Sub
End If
```

### SDKの初期化

まず、SDKを初期化します。

```vb
Dim Client As Ekispert
Set Client = New Ekispert
Client.ApiKey = ApiKey
```

### 過去の入力補完データを削除

`データ` シートにある過去の入力データをクリアします。

```vb
Dim i As Integer
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 ' 何もデータがない場合
    LastRow = 2
End If
If Not sheet.Range(RowName & "2:" & RowName & LastRow).Find(Target.value) Is Nothing Then
    ' 選択された場合
    Exit Sub
End If
' 範囲をクリア
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
```

### 駅名検索を実行する

`駅簡易情報` 検索を実行します。これは `StationLightQuery` を使います。

```vb
Dim Query As StationLightQuery
Set Query = Client.StationLightQuery()
Dim Result As ResultSet
Query.Name = Target.value ' 入力された駅名
Query.NameMatchType = Partial ' 部分一致
Result = Query.Find
' エラーチェック
If Result.Success = False Then
    MsgBox Result.Error.Message
    Exit Sub
End If
```

### 結果を描画する

検索がうまくいったら、それを `データ` シートに書き込みます。検索結果の構造は[駅簡易情報](https://docs.ekispert.com/v1/api/station/light.html?utm_source=qiita&utm_medium=referral&utm_campaign=api-column&utm_id=202502-1)のレスポンスを参照してください。プロパティ名が複数形になっているものは、配列になります。

```vb
' 結果を描画する
For i = 0 To UBound(Result.Points)
    sheet.Cells(i + 2, (RowIndex * 2) - 1).value = Result.Points(i).Station.Name ' 駅名
    sheet.Cells(i + 2, (RowIndex * 2)).value = Result.Points(i).Station.Code     ' 駅コード
Next i
```

### 結果範囲をリストにする

`データ` シートに出力した内容に合わせて、`経路入力` シートのセルにリストを作成します。

```vb
' その範囲をリスト入力にする
With Target.Validation
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertInformation, _
        Operator:=xlBetween, Formula1:="=データ!$" & RowName & "$2:$" & RowName & "$" & UBound(Result.Points) + 1
    .IgnoreBlank = True
    .InCellDropdown = True
    .InputTitle = ""
    .ErrorTitle = ""
    .InputMessage = ""
    .ErrorMessage = ""
    .IMEMode = xlIMEModeNoControl
    .ShowInput = True
    .ShowError = True
End With
```

これで、駅名を入力すると、その駅名に一致する駅コードがリストに表示されるようになります。

## 経路探索を実行する

`経路入力` シートに入力された値を使って、経路探索を実行します。まず、関数の名前だけ作っておきます。

```vb
Sub SearchRoute()
  ' ここに処理を書く
End Sub
```

そして、 `経路入力` シートにボタンを配置し、そのボタンをクリックしたときに `SearchRoute` が実行されるようにします。

![image4.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/197026/c0a8a2f6-6684-4a65-8d27-7c215f1dc09c.png)


### SDKの初期化

先ほどと同じく、SDKを初期化します。

```vb
Dim Client As Ekispert
Set Client = New Ekispert
Client.ApiKey = ApiKey
```

### 駅コードの取得

指定されている駅名から、 `データ` シートにある駅コードを取得します。

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

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

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

### 経路探索を実行する

経路探索を実行します。これは `CourseExtremeQuery` を使います。

```vb
Dim Course As Course
Dim Point As Point

Dim Query As CourseExtremeQuery
Set Query = Client.CourseExtremeQuery
Query.ViaList(0) = Join(Codes, ":")
Query.SearchType = Plain
Dim Result As ResultSet
Result = Query.Find
If Result.Success = False Then
    MsgBox Result.Error.Message
    Exit Sub
End If
```

### 結果を出力する

探索結果を出力します。新しいシートを作成し、その中に結果を出力します。

```vb
' 新しいシートを作成する
Dim ResultSheet As Worksheet
Set ResultSheet = Worksheets.Add
ResultSheet.Name = BoardingName & "から" & DestinationName
```

結果を出力します。結果の構造は[経路探索](https://docs.ekispert.com/v1/api/search/course/extreme.html?utm_source=qiita&utm_medium=referral&utm_campaign=api-column&utm_id=202502-1)のレスポンスを参照してください。

```vb
Dim RowIndex As Long
Dim ColumnIndex As Long
ColumnIndex = 1
For i = 0 To UBound(Result.Courses)
    Course = Result.Courses(i)
    
    RowIndex = 1
    ResultSheet.Cells(RowIndex, ColumnIndex).value = "ルート" & i + 1
    RowIndex = RowIndex + 1
    ResultSheet.Cells(RowIndex, ColumnIndex).value = "合計" & GetPrice(Course.Prices) & "円"
    RowIndex = RowIndex + 2
    ResultSheet.Cells(RowIndex, ColumnIndex).value = "乗車駅"
    ResultSheet.Cells(RowIndex, ColumnIndex + 1).value = "路線名"
    ResultSheet.Cells(RowIndex, ColumnIndex + 2).value = "降車駅"
    RowIndex = RowIndex + 1
    
    Dim j As Long
    For j = 0 To UBound(Course.Route.Lines)
        ResultSheet.Cells(RowIndex, ColumnIndex).value = Course.Route.Points(j).Station.Name
        ResultSheet.Cells(RowIndex, ColumnIndex + 1).value = Course.Route.Lines(j).Name
        ResultSheet.Cells(RowIndex, ColumnIndex + 2).value = Course.Route.Points(j + 1).Station.Name
        RowIndex = RowIndex + 1
    Next j
    ColumnIndex = ColumnIndex + 4
Next i
```

`GetPrice` は、経路探索の結果から、通常料金 `FareSummary` を取得する関数です。

```vb
Function GetPrice(Prices() As Price) As Long
    Dim Price As Price
    Dim i As Long
    For i = 0 To UBound(Prices)
        Price = Prices(i)
        If Price.Kind = "FareSummary" Then
            GetPrice = Val(Price.Oneway)
            Exit Function
        End If
    Next i
    GetPrice = 0
End Function
```

![image2.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/197026/f3940c3e-0cbb-4446-a528-cc830775e131.png)


## まとめ

今回は駅簡易情報と経路探索を使って、VBA SDKから駅名情報の検索と、経路探索を行う方法を紹介しました。SDKを使うことで、簡単に駅すぱあとAPIを利用することができます。ぜひ、実際に使ってみてください。

[駅すぱあと API Documents 駅データ・経路検索のWebAPI](https://docs.ekispert.com/v1/index.html?utm_source=qiita&utm_medium=referral&utm_campaign=api-column&utm_id=202502-1)