VBAのお勉強　住所の文字列→緯度・経度を求める

　http://q.hatena.ne.jp/1207343267

例えば、

こんな、Excelファイルがあった時、B列に緯度、C列に経度を入れる。。。

緯度・経度を求めるには、例えばYahoo!さんなんかでは、APIが公開されてます。

ローカルサーチAPI
こちらを使えば、住所の文字列で問い合わせれば、結果がXMLで返ってきます。

その中に緯度・経度も含まれますので、そこからうまく抜き出せば、おっけいですね。

Googleさんでも、APIがあるみたいです。

Google Maps API
で、やはり、同じようにXMLで返ってくる？ようです。

これらを使えば、うまく出来そう（＾＾）、、、なんですが。

ちょっと気になっているのが、例えば、Yahoo!さんの場合、
http://developer.yahoo.co.jp/map/

のページによると、Yahoo!地図情報Webサービスの利用について

• 限られた人、コンピュータによるアクセスのみ認めているサイトでのご使用
• 企業、官公庁その他の団体におけるイントラネット内でのご使用
• 地図の使用によりユーザーから利益を得ていると認められるサイトでのご使用

ってあるんですよね。。。

これって、このAPIを使って、住所→緯度経度を求めるプログラムを作った場合、その仕組みはおそらくローカルのネットワークから使うであろう物（外部にこの仕組みを公開するわけではない）だと思いますので、規約に違反しないのかな？
http://developer.yahoo.co.jp/terms/の利用規約を見てみても、（太字はこちらでつけました。）

利用者は、Yahoo! JAPANのAPI に関するコメント、ノウハウ、方法論、プロシジャ、技術、データやYahoo! JAPANのAPIを使用して開発したアプリケーションを、Yahoo!デベロッパーネットワークのコミュニティーに掲載するなど不特定多数の他の利用者がアクセスできるようにしなければならず、これをもって、Yahoo! JAPANに対して、利用者に対する通知および利用者の権利表示をすることなく、日本の国内外において、無償で非独占的にそれらを使用する（複製、公開、送信、頒布、譲渡、貸与、翻訳、翻案を含む）権利を許諾（サブライセンス権を含む）したものとみなします。また、利用者は、Yahoo! JAPANのAPI に関するコメント、ノウハウ、方法論、プロシジャ、技術、データやYahoo! JAPANのAPIを使用して開発したアプリケーションについて、著作者人格権を行使しないものとします。

（＾＾；）難しい事書いてありますが、ようするに、

「APIを使ったアプリケーションは、外部から誰もが使える仕組みにしないと駄目」

っていってるような気がします。

最終的にこの機能を用いて作成した住所と地図が入ったWebページを公開することにはなりますが、、、
この仕組み自体を公開しないと駄目なんじゃないかな？

もちろんWebサーバー上で、住所の文字列をCGIに渡して、そこからAPIを呼んで結果のXMLを取り込み、そこから地図を出す。みたいな流れであれば、全く問題ない使い方だとは思いますが。。。

これは、Googleさんでも同じ？なのかな？

http://code.google.com/intl/ja/apis/maps/signup.html によると、やはり、

エンドユーザーが自由にアクセスできるサービスを提供してください。

ってあるんですよね。。。

というわけで、Excel→API→Excelって流れは、なんとなくまずいような気がします。（実際はどうだか分かりませんが）

09/05/12追記
こちらの記事に、googleさんの利用について詳細な内容があります。
誰からもアクセスできる事、デスクトップアプリケーションの場合はそのアプリケーションが誰でも利用できること、って事でいいのかな？

Yahoo!さんの場合、http://www.alpsmap.jp/asp/api.htmlで同等のサービスで有料のものはあります。
Googleさんの場合も、http://www.google.com/enterprise/maps/で同じようなことが出来るようです。

これらを使えば、もちろん問題はないでしょう。

。

。

。

といって、、、これであきらめちゃうのもなぁ。

http://map.yahoo.co.jp/から、「東京都新宿区西新宿二丁目８番１号」で検索すれば、

って、出ます。この検索結果の「東京都新宿区西新宿2丁目8-1」のURLを見てみると、

　
　

http://map.yahoo.co.jp/pl?p=%C5%EC%B5%FE%C5%D4%BF%B7%BD%C9%B6%E8%C0%BE%BF%B7

%BD%C9%C6%F3%C3%FA%CC%DC%A3%B8%C8%D6%A3%B1%B9%E6&
lat=35.68627083&lon=139.69494083&type=&gov=13104.67.2.8.1
　
　

・・・lat　lon　これって、緯度、経度なんですよね。この値を取ってくれば。。。

APIは使ってないし、公開されてる情報だからどう加工しても問題ないですよね？（＾＾；）＞Yahoo!さん。

というわけで、APIは使わずにYahoo!地図情報を使ってみたいと思います。

考え方はJavaScriptとかでやってた「スクレイピング」ですね。

まずは、VBAからインターネット上のリソースをURLを指定して取ってくる方法を調べてみます。

「VBA WEB HTMLを取得」で検索すると、こちらのページが見つかりました。その中に紹介されていたこちらのページがわかりやすかったです。

とりあえず、VBAから、Yahoo!のトップのHTMLのソースを取ってきて、イミディエイトウィンドウに表示してみます。

　
Sub test()
Dim oHttp As Object
Set oHttp = CreateObject("MSXML2.XMLHTTP")
oHttp.Open "GET", "http://www.yahoo.co.jp/", False
oHttp.Send
Debug.Print oHttp.responseText
End Sub

実行してみると、

ん、表示しきれてませんが、取れているようです（＾＾）

では今度はYahoo!地図情報から「東京都新宿区西新宿二丁目８番１号」で検索したときのHTMLのソースを表示してみます。

http://map.yahoo.co.jp/から、「東京都新宿区西新宿二丁目８番１号」で検索した結果のURLは、

　
　

http://search.map.yahoo.co.jp/search?q=&p=%C5%EC%B5%FE%C5%D4%BF%B7%BD%C9%B6

%E8%C0%BE%BF%B7%BD%C9%C6%F3%C3%FA%CC%DC%A3%B8%C8%D6%A3%B1%B9%E6
&gc=&rsmode=map&ei=euc-jp&type=　
　
　

ですので、これを与えてみます。

Sub test()
 Dim oHttp As Object
 Set oHttp = CreateObject("MSXML2.XMLHTTP")
 oHttp.Open "GET", "http://search.map.yahoo.co.jp/search?q=&p=%C5%EC%B5%FE%C5%D4%BF%B7%BD%C9%B6%E8%C0%BE%BF%B7%BD%C9%C6%F3%C3%FA%CC%DC%A3%B8%C8%D6%A3%B1%B9%E6&gc=&rsmode=map&ei=euc-jp&type=", False
 oHttp.Send
 Debug.Print oHttp.responseText
End Sub

実行すると、、、長い結果のソースが取得できます。

ところどころに「 ? 」となっているのは、おそらく文字コードが違うからでしょうが、今回欲しい情報の部分は関係なさげです。

のあたりに、

ってありますね（＾＾）。この情報を抜き出せばよさそうです。

こういうの、抜き出すのはやっぱり正規表現を使うべき、だとは思うのですが、やはり、参照設定とかあんまり好きじゃないので（＾＾；）　泥臭い方法でやってみます。

といっても、取ってきたソースの中から、lat=の部分とlon=の部分を探してくるだけですから、そんなに難しくありません。

Sub test()

Dim lat As String
Dim lon As String

Dim nukidashi As String

Dim oHttp As Object
Set oHttp = CreateObject("MSXML2.XMLHTTP")
oHttp.Open "GET", "http://search.map.yahoo.co.jp/search?q=&p=%C5%EC%B5%FE%C5%D4%BF%B7%BD%C9%B6%E8%C0%BE%BF%B7%BD%C9%C6%F3%C3%FA%CC%DC%A3%B8%C8%D6%A3%B1%B9%E6&gc=&rsmode=map&ei=euc-jp&type=", False
oHttp.Send

'とりあえず、nukidashiに、「lat=」以降の文字列を入れます。

nukidashi = Mid(oHttp.responseText, InStr(oHttp.responseText, "lat=") + 4)

'次の「&」までがlatです。

lat = Mid(nukidashi, 1, InStr(nukidashi, "&") - 1)

'nukidashiを「lon=」以降の文字列にします。

nukidashi = Mid(nukidashi, InStr(nukidashi, "lon=") + 4)

'次の「&」までがlonです。

lon = Mid(nukidashi, 1, InStr(nukidashi, "&") - 1)

Debug.Print "緯度"; lat
Debug.Print "経度"; lon

End Sub

実行してみると、

ん、取れました（＾＾）

後は、ExcelのA列に入ってる文字列をURLに与えて、取ってきたデータを、B列、C列に戻す、って感じですね。

・・・って、どうやってURLを求めればいいんでしょうか？（＾＾；）
「東京都新宿区西新宿二丁目８番１号」で検索した結果のURLは、

http://search.map.yahoo.co.jp/search?q=&

p=%C5%EC%B5%FE%C5%D4%BF%B7%BD%C9%B6%E8%C0%BE%BF%B7%BD%C9%C6%F3%C3%FA%CC%DC%A3%B8%C8%D6%A3%B1%B9%E6
&gc=&rsmode=map&ei=euc-jp&type=
　
　

長いので途中で改行しましたが、この赤い部分の「p=」で始まる部分が、「東京都新宿区西新宿二丁目８番１号」を表しているようです。
ということは、この文字列を作り出さないといけない、って事ですね。
どうやらこの文字列は、「東京都新宿区西新宿二丁目８番１号」をeuc-jpでエンコードしたもののようです。

こちらのページで、「東京都新宿区西新宿二丁目８番１号」で、euc-jpで変換してみると、

ん、確かにp=で与えている文字列になってます。

では、この文字を作ればいいのか、、、とはいえ、Excelって、基本的にはShift-JISなので、Shift-JISからEUCに変換しないといけませんね。

「VBA　SJIS EUC 変換」で検索すると、こちらのサイトが見つかりました。
こちらのサイトを参考に、Shift-JIS→EUCの部分を組み込んでみたいと思います。

Sub test()

    Dim lat As String
    Dim lon As String

    Dim nukidashi As String
    Dim eucurlencode As String

    Dim oHttp  As Object
    Set oHttp = CreateObject("MSXML2.XMLHTTP")

    eucurlencode = getEUC("東京都新宿区西新宿二丁目８番１号")

    Debug.Print "pの文字列は" + eucurlencode

    oHttp.Open "GET", "http://search.map.yahoo.co.jp/search?q=&p=" + eucurlencode + "&gc=&rsmode=map&ei=euc-jp&type=", False
    oHttp.Send

    'とりあえず、nukidashiに、「lat=」以降の文字列を入れます。

    nukidashi = Mid(oHttp.responseText, InStr(oHttp.responseText, "lat=") + 4)

    '次の「&」までがlatです。

    lat = Mid(nukidashi, 1, InStr(nukidashi, "&") - 1)

    'nukidashiを「lon=」以降の文字列にします。

    nukidashi = Mid(nukidashi, InStr(nukidashi, "lon=") + 4)

    '次の「&」までがlonです。

    lon = Mid(nukidashi, 1, InStr(nukidashi, "&") - 1)

    Debug.Print "緯度"; lat
    Debug.Print "経度"; lon
End Sub

Function getEUC(CHK_DATA)
    'http://www.ken3.org/asp/backno/asp107.html を使わせていただきました。

    Dim n As Integer
    Dim strWORK As String
    Dim strCODE As String
    Dim P As String
    Dim sEUC As String

    For n = 1 To Len(CHK_DATA)
      strWORK = Mid(CHK_DATA, n, 1)
      strCODE = Hex(Asc(strWORK))
      If Len(strCODE) <= 2 Then
        If strWORK = " " Then
          P = P & "+"
          Else
          P = P & strWORK
        End If
      Else
        sEUC = SJIStoEUC(strCODE)
        P = P & "%" & Mid(sEUC, 1, 2) & "%" & Mid(sEUC, 3, 2)
      End If
    Next

    getEUC = P

End Function

Function SJIStoEUC(strSJISCODE)
    'http://www.ken3.org/asp/backno/asp107.html を使わせていただきました。
    Dim hi
    Dim lo

    'シフトJISコードの上位バイトを hi、下位バイトを lo とします。
    hi = CLng("&h" & Mid(strSJISCODE, 1, 2))
    lo = CLng("&h" & Mid(strSJISCODE, 3, 2))

    If hi <= &H9F Then
      hi = hi - &H71 'hi が 0x9f 以下の場合、 hi から 0x71 減じます。
    Else
      hi = hi - &HB1 'そうでない場合、 hi から 0xB1 減じます。
    End If

    'hi に 2 を乗じて、さらに 1 を加えます。
    hi = hi * 2 + 1

    'lo が 0x7F より大きい場合、 lo から 1 減じます。
    If lo > &H7F Then lo = lo - 1

    'lo が 0x9E 以上の場合、lo から 0x7D 減じて、hi に 1 加えます。
    If lo >= &H9E Then
        lo = lo - &H7D
        hi = hi + 1
    Else 'そうでない場合、 lo から 0x1F 減じます。
        lo = lo - &H1F
    End If

    'JISの hi と lo ができたので、0x80 を or して 最上位のビットを立てます。
    hi = hi Or &H80
    lo = lo Or &H80

    '結果を返します
    SJIStoEUC = Right("0" & Hex(hi), 2) & Right("0" & Hex(lo), 2)

End Function

getEUC、SJIStoEUCのいずれも、http://www.ken3.org/asp/backno/asp107.htmlを参考に（ほぼ丸写しですが）、作成させていただきました。
とりあえず、「東京都新宿区西新宿二丁目８番１号」を求めるようにしてあります。
実行してみると、

　　ん、きちんと変換できてますね（＾＾）

では、最後です。いつものようにA列を全行みて、B,C列に値を入れてみます。

]
Sub test()

    Dim lastgyou As Integer
    Dim i As Integer

    Dim lat As String
    Dim lon As String

    Dim nukidashi As String
    Dim eucurlencode As String

    Dim oHttp  As Object
    Set oHttp = CreateObject("MSXML2.XMLHTTP")

    'A列の最終行の行番号を求めます
    lastgyou = ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row

    For i = 1 To lastgyou

        'A列の値で検索します
        eucurlencode = getEUC(ActiveSheet.Cells(i, 1).Value)

        oHttp.Open "GET", "http://search.map.yahoo.co.jp/search?q=&p=" + eucurlencode + "&gc=&rsmode=map&ei=euc-jp&type=", False
        oHttp.Send

        '取得した結果をnukidashiに入れます
        nukidashi = oHttp.responseText

        'もし、nukidashiに、「lat=」 と「lot=」が含まれていた場合

        If InStr(nukidashi, "lat=") <> 0 And InStr(nukidashi, "lot=") <> 0 Then

        'とりあえず、nukidashiに、「lat=」以降の文字列を入れます。

        nukidashi = Mid(oHttp.responseText, InStr(oHttp.responseText, "lat=") + 4)

        '次の「&」までがlatです。

        lat = Mid(nukidashi, 1, InStr(nukidashi, "&") - 1)

        'nukidashiを「lon=」以降の文字列にします。

        nukidashi = Mid(nukidashi, InStr(nukidashi, "lon=") + 4)

        '次の「&」までがlonです。

        lon = Mid(nukidashi, 1, InStr(nukidashi, "&") - 1)

        '結果をB列、C列に代入します。

        ActiveSheet.Cells(i, 2).Value = lat
        ActiveSheet.Cells(i, 3).Value = lon

        End If

    Next i

End Sub

Function getEUC(CHK_DATA)
    'http://www.ken3.org/asp/backno/asp107.html を使わせていただきました。

    Dim n As Integer
    Dim strWORK As String
    Dim strCODE As String
    Dim P As String
    Dim sEUC As String

    For n = 1 To Len(CHK_DATA)
      strWORK = Mid(CHK_DATA, n, 1)
      strCODE = Hex(Asc(strWORK))
      If Len(strCODE) <= 2 Then
        If strWORK = " " Then
          P = P & "+"
          Else
          P = P & strWORK
        End If
      Else
        sEUC = SJIStoEUC(strCODE)
        P = P & "%" & Mid(sEUC, 1, 2) & "%" & Mid(sEUC, 3, 2)
      End If
    Next

    getEUC = P

End Function

Function SJIStoEUC(strSJISCODE)
    'http://www.ken3.org/asp/backno/asp107.html を使わせていただきました。
    Dim hi
    Dim lo

    'シフトJISコードの上位バイトを hi、下位バイトを lo とします。
    hi = CLng("&h" & Mid(strSJISCODE, 1, 2))
    lo = CLng("&h" & Mid(strSJISCODE, 3, 2))

    If hi <= &H9F Then
      hi = hi - &H71 'hi が 0x9f 以下の場合、 hi から 0x71 減じます。
    Else
      hi = hi - &HB1 'そうでない場合、 hi から 0xB1 減じます。
    End If

    'hi に 2 を乗じて、さらに 1 を加えます。
    hi = hi * 2 + 1

    'lo が 0x7F より大きい場合、 lo から 1 減じます。
    If lo > &H7F Then lo = lo - 1

    'lo が 0x9E 以上の場合、lo から 0x7D 減じて、hi に 1 加えます。
    If lo >= &H9E Then
        lo = lo - &H7D
        hi = hi + 1
    Else 'そうでない場合、 lo から 0x1F 減じます。
        lo = lo - &H1F
    End If

    'JISの hi と lo ができたので、0x80 を or して 最上位のビットを立てます。
    hi = hi Or &H80
    lo = lo Or &H80

    '結果を返します
    SJIStoEUC = Right("0" & Hex(hi), 2) & Right("0" & Hex(lo), 2)

End Function　

　
　ループでまわすのはいつもどおりです。A列の値をとって、緯度経度を求め、B列、C列に代入します。
また、検索した結果、「lat=」「lot=」がない場合は無視します。
実行すると、、、

ん、値は入りました（＾＾）
この値を使って、地図を表示させてみると、、、
http://map.yahoo.co.jp/pl?type=static&lat=35.68627083&lon=139.69494083…
http://map.yahoo.co.jp/pl?type=static&lat=35.60133333&lon=140.12643806…
http://map.yahoo.co.jp/pl?type=static&lat=35.44441889&lon=139.64586389…
上３つ、東京都庁、千葉県庁、神奈川県庁の住所から得られたURLです。

ん、とりあえずおっけいかな？

もちろん、これはYahoo!できちんと該当する住所が検索されなければ出ませんし、仮に住所を入れて検索した結果、複数の候補があった場合、最初に出てきたlat= lon=を抜き出しますので、それ以降は無視されます。

とりあえず、こちらにアップしておきます。→vbastudy_23