ジオハッシュ関数でWebサービスのAPIを使わずに簡易に逆ジオコーディング

前回のエントリーで書いたジオハッシュ関数を用いて簡単な逆ジオコーディングを作ってみます。
想定している条件としては以下の通りです。

単一の県など限定した範囲
緯度経度から最も近いと思われる住所を得る
住所は街区レベル（「○○町△丁目□番」）または大字・町丁目レベル
ジオハッシュの性質上，最も近い住所が検索されない場合がある

「限定した範囲」としたのは，Excelファイル内部に住所と緯度経度の変換テーブルを作る必要がありますが，行数の限界が105万行弱のためです。ある県で作成したところ，街区レベルでは20万行以上，同一座標の重複を除外しても10万行弱でした。
得られる情報は住所だけですが，WebサービスのAPIのように最寄り駅やランドマーク名などは得られません。
また，最も近い住所が検索されない場合があるため，精度が重要視される場合には使えません。

1 必要な位置情報データの入手
2 変換テーブルの作成
3 逆ジオコーディング関数の作成
4 関数の使用例

必要な位置情報データの入手

国土交通省の「位置参照情報ダウンロードサービス」から必要な情報をダウンロードします。

取得範囲を都道府県または市区町村から選択
得る情報を街区レベル，大字・町丁目レベル，すべてのいずれかを選択
データ整備年度を選択（通常は最新で良いでしょう）

変換テーブルの作成

ダウンロードしたファイルを解凍し，対象のCSVファイルを開きます。
前回作成した関数を標準モジュールに作成します。

Excel形式で保存します。2007以降の場合はマクロ有効ブック（xlsm）として下さい。
住所の列を作成します。

作成したジオハッシュ関数を用いて，ジオハッシュの列を作成します。

作成した住所とジオハッシュの列は，再計算が起こらないよう，値として貼り付けします。
ファイル容量を減らすため，不要な列を削除します。

範囲をテーブルに変換し，シート名・テーブル名を”GeoHash”に変更します。

すべての住所の緯度経度が調査されているわけではないようで，複数の住所で同じ緯度経度が含まれている場合がありますので，重複を削除します。

ジオハッシュを昇順で並べ替えます。これは，後で使うMATCH関数で検索するときに，照合型1を用いるためです。MATCH関数の詳細についてはここでは割愛しますので，別途検索して下さい。

逆ジオコーディング関数の作成

次のコードを標準モジュールに追加します。

'ジオハッシュを用いた逆ジオコーディング
Private Function ReverseGeoCoding(ByVal Lat As Double, _
                    ByVal Lng As Double) As String

    Dim GeoHash As String, R As Long
    Dim Dist As Double, Dist1 As Double
    Dim lst As ListObject
    
    '変換テーブルをセット
    Set lst = ThisWorkbook.Worksheets("GeoHash").ListObjects("GeoHash")
    
    GeoHash = CnvGeoHash(Lat, Lng) '緯度経度をジオハッシュに変換
    
    On Error GoTo ErrExit1 'MATCH関数のエラー処理（指定した検査値が見つからない場合）
        '変換テーブルから最も近いハッシュの行を検索
        R = WorksheetFunction.Match(GeoHash, _
                    lst.ListColumns("ジオハッシュ").DataBodyRange, 1)
    On Error GoTo 0 'エラー処理範囲終了
    
    'MATCH関数で見つかった場合，その行または次の行が最も近い場所
    Dist = ((lst.ListColumns("緯度").DataBodyRange(R) - Lat) ^ 2 + _
        (lst.ListColumns("経度").DataBodyRange(R) - Lng) ^ 2) ^ 0.5
    Dist1 = ((lst.ListColumns("緯度").DataBodyRange(R + 1) - Lat) ^ 2 + _
        (lst.ListColumns("経度").DataBodyRange(R + 1) - Lng) ^ 2) ^ 0.5
        
    If Dist > Dist1 Then '次の行が近い場合
        R = R + 1: Dist = Dist1 ' その行を採用する
    End If
    
    If Dist > 0.002 Then '誤差が大きい場合
        ReverseGeoCoding = "#N/A" 'エラー値を返す
    Else
        ReverseGeoCoding = lst.ListColumns("住所").DataBodyRange(R)
    End If
    
    Exit Function
    
ErrExit1: 'MATCH関数で見つからない場合
    
    ReverseGeoCoding = "#N/A" 'エラー値を返す
    
End Function

'ジオハッシュを用いた逆ジオコーディング

Private Function ReverseGeoCoding(ByVal Lat As Double, _

ByVal Lng As Double) As String

Dim GeoHash As String, R As Long

Dim Dist As Double, Dist1 As Double

Dim lst As ListObject

'変換テーブルをセット

Set lst = ThisWorkbook.Worksheets("GeoHash").ListObjects("GeoHash")

GeoHash = CnvGeoHash(Lat, Lng) '緯度経度をジオハッシュに変換

On Error GoTo ErrExit1 'MATCH関数のエラー処理（指定した検査値が見つからない場合）

'変換テーブルから最も近いハッシュの行を検索

R = WorksheetFunction.Match(GeoHash, _

lst.ListColumns("ジオハッシュ").DataBodyRange, 1)

On Error GoTo 0 'エラー処理範囲終了

'MATCH関数で見つかった場合，その行または次の行が最も近い場所

Dist = ((lst.ListColumns("緯度").DataBodyRange(R) - Lat) ^ 2 + _

(lst.ListColumns("経度").DataBodyRange(R) - Lng) ^ 2) ^ 0.5

Dist1 = ((lst.ListColumns("緯度").DataBodyRange(R + 1) - Lat) ^ 2 + _

(lst.ListColumns("経度").DataBodyRange(R + 1) - Lng) ^ 2) ^ 0.5

If Dist > Dist1 Then '次の行が近い場合

R = R + 1: Dist = Dist1 ' その行を採用する

End If

If Dist > 0.002 Then '誤差が大きい場合

ReverseGeoCoding = "#N/A" 'エラー値を返す

Else

ReverseGeoCoding = lst.ListColumns("住所").DataBodyRange(R)

End If

Exit Function

ErrExit1: 'MATCH関数で見つからない場合

ReverseGeoCoding = "#N/A" 'エラー値を返す

End Function

関数の使用例

シートやVBAのコード内から関数を呼び出して使用することが出来ます。

必要な位置情報データの入手

変換テーブルの作成

逆ジオコーディング関数の作成

関数の使用例

関連記事

共有: