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

今回は、以前作成した「駅すぱあと 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を利用することができます。ぜひ、実際に使ってみてください。

駅すぱあと API Documents 駅データ・経路検索のWebAPI