本記事はヴァル研究所の支援として作成された記事です
今回は、以前作成した「駅すぱあと API」をExcel VBAから利用して、経費精算用に経路探索を行う #経路検索 - Qiitaの内容を、VBA SDKを使って書き直してみました。
普段Excelで経費精算の作業を行なっている場合、駅すぱあと VBA SDKを使うことで簡単に経路情報や運賃を算出することができます。
EkispertAPIMania/VBA-SDK: Excel VBAなどで動作する駅すぱあと VBA SDKです（Windowsのみ）の実践的な使い方として、参考にしてください。
コードについて
今回のデモコードはVBA-SDK/demo at main · EkispertAPIMania/VBA-SDKの中に Route.xlsm として保存してあります。実装時の参考にしてください。
利用している機能
このデモでは、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が組み込まれました。
シートの準備
今回は以下の2つのシートを利用します。
- 経路入力
- データ
経路入力シート
経路入力 シートには、以下のように入力欄を作成します。
| A | B |
|---|---|
| 出発駅 | |
| 経由駅1 | |
| 経由駅2 | |
| 到着駅 |
データシート
データ シートには、以下のように入力欄を作成します。
| 出発駅名 | 出発駅コード | 経由1駅名 | 経由1コード | 経由2駅名 | 経由2コード | 到着駅名 | 到着駅コード |
|---|---|---|---|---|---|---|---|
APIキーの設定
新しい標準モジュールを作成して、以下のコードを貼り付けます。 YOUR_API_KEY の部分を、取得した駅すぱあと APIのAPIキーに置き換えてください。
Public Const ApiKey As String = "YOUR_API_KEY"
入力された値を使って、駅名を検索してドロップダウンを作成する
駅名を入力して、確定されたら 駅簡易情報 検索を実行します。処理は Private Sub Worksheet_Change(ByVal Target As Range) にて実行します。
Private Sub Worksheet_Change(ByVal Target As Range)
' ここに処理を書く
End Sub
処理対象がない場合は、何もせず処理を終了します。
If Intersect(Target, Range("B1:B4")) Is Nothing Then
Exit Sub
End If
SDKの初期化
まず、SDKを初期化します。
Dim Client As Ekispert
Set Client = New Ekispert
Client.ApiKey = ApiKey
過去の入力補完データを削除
データ シートにある過去の入力データをクリアします。
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 を使います。
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
結果を描画する
検索がうまくいったら、それを データ シートに書き込みます。検索結果の構造は駅簡易情報のレスポンスを参照してください。プロパティ名が複数形になっているものは、配列になります。
' 結果を描画する
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
結果範囲をリストにする
データ シートに出力した内容に合わせて、経路入力 シートのセルにリストを作成します。
' その範囲をリスト入力にする
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
これで、駅名を入力すると、その駅名に一致する駅コードがリストに表示されるようになります。
経路探索を実行する
経路入力 シートに入力された値を使って、経路探索を実行します。まず、関数の名前だけ作っておきます。
Sub SearchRoute()
' ここに処理を書く
End Sub
そして、 経路入力 シートにボタンを配置し、そのボタンをクリックしたときに SearchRoute が実行されるようにします。
SDKの初期化
先ほどと同じく、SDKを初期化します。
Dim Client As Ekispert
Set Client = New Ekispert
Client.ApiKey = ApiKey
駅コードの取得
指定されている駅名から、 データ シートにある駅コードを取得します。
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 は、 データ シートにある駅名から駅コードを取得する関数です。
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 を使います。
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
結果を出力する
探索結果を出力します。新しいシートを作成し、その中に結果を出力します。
' 新しいシートを作成する
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(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 を取得する関数です。
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
まとめ
今回は駅簡易情報と経路探索を使って、VBA SDKから駅名情報の検索と、経路探索を行う方法を紹介しました。SDKを使うことで、簡単に駅すぱあとAPIを利用することができます。ぜひ、実際に使ってみてください。