気になる話題

GoogleのAPI以外でExcelのvbaで住所から緯度経度を取得する方法

投稿日:

今回は、Excelのvbaを使用して、セルに入力した住所から緯度経度を取得する方法を紹介します。

この方法についてですが、以前はGoogleのGeocodingサービスを使って、住所から緯度経度情報を取得していました。

ただ最近使ってみると、どうやらapiキーを設定してからでないとできなくなってしまったみたいで、今回急遽調査することになりました。

 

 

GoogleMapは使えなくなった

使えなくなったと書いていますが、実際は「Geocoding API」を設定すれば使用できます。

ただし、「Geocoding API」は「請求を有効にする」を設定しないと使えなかったり、使用回数によっては料金が発生するなどがあります。

しかもクレジットカード情報を登録したりと面倒です。

あとは、作ったExcelを色々な人に使ってもらうにしても、「Geocoding API」をそれぞれに設定しないといけないなど、かなり使いにくくなってしまいました。

そもそも、以前は地図表示も問題なかったのに、APIキーを設定していないアクセスについては地図が表示されなくなったりもしています。

無料で使用できる範囲もありますが2018年7月16日からは

1日25,000リクエスト → 月28,000リクエスト

と大幅に表示回数も減っています。

つまり地図表示や住所から緯度経度取得などを1日平均1000回APIを使用したら有料になるということです。

 

 

GoogleのAPI以外で住所から緯度経度を取得する方法は?

ということでGoogleのAPI以外でExcelのvbaを使用して住所から緯度経度を取得する方法ですが

地理院地図のAPIを使用します。

地理院地図については、一般の人はほとんど知らないと思いますが、国土地理院という国の組織が作っている地図になります。

使用方法についてですが、セルに入力した住所を引数にしてhttpリクエストを行います。

検索結果はJSONで返ってくるので、必要な情報(今回は緯度経度)を取り出します。

※JSONのコンバートには「JsonConverter」を使用しています。

では実際の方法についてですが、以下のようにボタンを配置してA列に住所を入力します。

 

あとはボタンをクリックすると緯度・経度表示されます。

実際のソースは以下のようになります。

あらかじめ「JsonConverter」はインポートしておきます。

Moduel1に以下のコードを記述します。

Sub getLatLon()
    Dim params As New Dictionary
    Dim httpReq As New XMLHTTP60
    Dim jsonObj As Object
    Dim adr() As String
    Dim cnt As Long
    Dim row As Integer
    Dim i As Integer
    
    cnt = 0
    row = 3
    
    Do
        If Worksheets("Sheet1").Cells(row, 1) = "" Then
            Exit Do
        End If
        
        cnt = cnt + 1
        ReDim Preserve adr(cnt)
        adr(cnt) = Worksheets("Sheet1").Cells(row, 1)
        
        row = row + 1
    Loop
    
    If cnt = 0 Then
        Exit Sub
    End If
    
    For i = 1 To cnt
        params.Add "q", adr(i)
    
        With httpReq
          .Open "GET", "https://msearch.gsi.go.jp/address-search/AddressSearch?" & encodeParams(params)
          .send
        End With
        Set jsonObj = JsonConverter.ParseJson(httpReq.responseText)
        Worksheets("Sheet1").Cells(i + 2, 2) = jsonObj(1)("geometry")("coordinates")(2)
        Worksheets("Sheet1").Cells(i + 2, 3) = jsonObj(1)("geometry")("coordinates")(1)
        
        params.RemoveAll
    Next

End Sub
Function encodeParams(pDic As Dictionary)
    
    Dim ary() As String
    ReDim ary(pDic.Count - 1) As String

    Dim i As Long
    For i = 0 To pDic.Count - 1
        ary(i) = pDic.Keys(i) & "=" & Application.WorksheetFunction.EncodeURL(pDic.Items(i))
    Next i

    encodeParams = Join(ary, "&")

End Function

あとは「getLatLon」をボタンのマクロに登録して完成です。

 

まとめ

以前作ったVBAの住所から緯度経度を取得するプログラムが動かなくなったということで、急遽別の方法を探していたところ今回の方法を見つけることができました。

Googleだけではありませんが、知らないうちに仕様が変わっていたり、規約が変更になるなどはよくあることです。

その時になって困らないように複数の方法を用意しないと危険だなと改めて思いました。

 

-気になる話題

執筆者:


comment

メールアドレスが公開されることはありません。 * が付いている欄は必須項目です

関連記事

no image

瀬戸大也と馬淵優佳(嫁・妻)との離婚はある?

競泳の瀬戸大也選手に不倫報道が出ました。 その奥さんは元飛び込みの馬淵優佳さんです。 今年の3月に、次女が生まれたばかりなのに不倫ということで、今後離婚などあるのでしょうか? 関連記事 →瀬戸大也が格 …

no image

大坂なおみ全米オープン2020の決勝は何時から?放送予定は?

大坂なおみ選手が全米オープンテニス2020で2年ぶりに決勝進出ということで盛り上がっていますね! 全米オープンでは2年ぶり、グランドスラムとしては3度目の決勝進出で、勝てば3度目の四大大会制覇になりま …

no image

台風10号がヤバそうなので停電対策にポータブル電源を買ってみた

2020年の台風10号(ハイシェン)がかなりヤバそうです。 台風10号が発生する前は、関西や四国に向かうようなことが言われていて九州は9号が通り過ぎれば問題ないかと思っていたところ、どんどん西寄りに進 …

no image

「TOKIO×嵐」から「関ジャニ∞村上」へ!日テレ2021元旦はDASH→夜ふかし!放送時間や内容は?

2020年まで10年間つづいていた元日恒例番組【TOKIO×嵐】 「ザ!鉄腕!DASH!!」→「嵐にしやがれ」 ですが、2020で嵐が活動を休止するということで「嵐にしやがれ」も終了します。 というこ …

no image

【速報】石原さとみの結婚!相手は一般男性?画像・職業は?

女優の石原さとみさんが結婚を発表しました! 同年代の一般男性で同居はまだ。 入籍は良き日を選んで年内にする予定・式・披露宴は未定ということです。 というかいきなりの結婚報告ということでかなりの衝撃です …