人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

Excelのマクロを使って2つの住所の直線距離を求めたいです。

今、Sheet1のA1セルに、大阪にある通天閣の住所が記載されております。
A2セルに四天王寺、A3セルに大阪城と、周辺のスポットの住所が記載されています。
そういうスポット情報が、A2セルから2万行ぐらいあります。

この状況から、A1セルの通天閣の住所と、各セルの住所の直線距離を調べ、その距離をB列などに出力するような。
そんな処理がもし可能でしたら、お教えいただきたいのですが。
2点間の距離を調べられるサイトは多く見つけられたのですが、一度に処理できる方法を見つけることが出来ませんでして。

よろしくお願い致します。

1437189907
●拡大する

●質問者: moon-fondu
●カテゴリ:インターネット 学習・教育
○ 状態 :終了
└ 回答数 : 2/2件

▽最新の回答へ

1 ● bnn
●700ポイント

面白そうだったので、調べてみました。

いくつか注意点

もっと正確で効率の良いコードは本職の方にお任せします。

f:id:bnn:20150718141723p:image

Sub GetLocation(address As String, ByRef lat As String, ByRef lng As String)
 Dim firstVal As String, secondVal As String, lastVal As String
 firstVal = "http://maps.googleapis.com/maps/api/geocode/json?address="
 lastVal = "&sensor=false"
 Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
 URL = firstVal & Replace(address, " ", "+") & lastVal
 objHTTP.Open "GET", URL, False
 objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
 objHTTP.send ("")
 If InStr(objHTTP.responseText, """lat""") = 0 Then GoTo ErrorHandl
 tmpVal = Right(objHTTP.responseText, Len(objHTTP.responseText) - InStr(objHTTP.responseText, """lat"" : ") - 7)
 lat = Split(tmpVal, ",")(0)
 tmpVal = Right(objHTTP.responseText, Len(objHTTP.responseText) - InStr(objHTTP.responseText, """lng"" : ") - 7)
 lng = Replace(Split(tmpVal, "}")(0), " ", "")
 Exit Sub
ErrorHandl:
 lat = lng = 0
End Sub

Private Function Distance(latitude1, longitude1, latitude2, longitude2)
earth_radius = 6378137
Pi = 3.14159265
deg2rad = Pi / 180
dLat = deg2rad * (latitude2 - latitude1)
dLon = deg2rad * (longitude2 - longitude1)
a = Sin(dLat / 2) * Sin(dLat / 2) + Cos(deg2rad * latitude1) * Cos(deg2rad * latitude2) * Sin(dLon / 2) * Sin(dLon / 2)
c = 2 * WorksheetFunction.Asin(Sqr(a))
d = earth_radius * c
Distance = Round(d)
End Function

Public Function GetDistance(address1 As String, address2 As String)
Dim lat1 As String, lng1 As String, lat2 As String, lng2 As String
Call GetLocation(address1, lat:=lat1, lng:=lng1)
Call GetLocation(address2, lat:=lat2, lng:=lng2)
GetDistance = Distance(lat1, lng1, lat2, lng2)
End Function

参考:
http://www.analystcave.com/excel-get-geolocation-coordinates-of-an-address/
http://www.codecodex.com/wiki/Calculate_distance_between_two_points_on_a_globe#Excel


moon-fonduさんのコメント
ありがとうございます。 実際に、標準モジュールで実行しようと試みたのですが・・・。 マクロを貼り付けても、マクロが出てこない http://f.st-hatena.com/images/fotolife/m/moon-fondu/20150719/20150719132052.jpg?1437279671 のです。 どのような手順で実行すればよろしいでしょうか?

magi-cocologさんのコメント
回答者の貼っている画像のように、B列に計算式を入れるのですよ

moon-fonduさんのコメント
bnnさんありがとうございます、うまく求めることができました!

2 ● a-kuma3
●3000ポイント ベストアンサー

Google Maps API の Geocoding API で緯度と経度を求めて、直線距離をヒュベニの公式で求めます。
まずは、VBA のコードを先に。
標準モジュールに貼り付けて、距離を求めたいシートを開いた状態で、SetDistance サブルーチンを実行してください。

Const LAT_COLUMN = 27
Const LNG_COLUMN = LAT_COLUMN + 1
Const DISTANCE_COLUMN = 2

Const MAX_ROWS = 20000


Function SetLocation(addr, lat, lng)
 Set xhr = CreateObject("MSXML2.ServerXMLHTTP")

 result = "-"

 URL = "http://maps.google.com/maps/api/geocode/xml?sensor=false&address=" & addr.Value
 xhr.Open "GET", URL, False
 xhr.send ""
 If xhr.StatusText = "OK" Then
 
 Set doc = xhr.responseXML.DocumentElement
 Set Status = doc.FirstChild  ' status
 If Status.Text = "OK" Then
 Set geo = doc.getElementsByTagName("geometry")
 Set Location = geo(0).FirstChild
 lat.Value = Location.FirstChild.Text
 lng.Value = Location.LastChild.Text
 result = "OK"
 Else
 result = Status.Text
 Debug.Print Status.Text
 End If

 Else
 result = xhr.StatusText
 End If

 Set xhr = Nothing

 If result <> "OK" Then
 lat.Value = "×"
 lng.Value = "×"
 End If

 SetLocation = result

End Function


Function deg2rad(deg)
 PI = Application.WorksheetFunction.PI()
 deg2rad = deg * PI / 180#
End Function

Function CalcDistance(lat1, lng1, lat2, lng2)

 If IsNumeric(lat1) And IsNumeric(lat2) Then
 a = 6378137#
 e2 = 6.69438002301188E-03
 mnum = 6335439.32708317  ' a * (1.0 - e2)

 my = deg2rad((lat1 + lat2) / 2#)
 dy = deg2rad(lat1 - lat2)
 dx = deg2rad(lng1 - lng2)

 s = Sin(my)
 w = Sqr(1# - e2 * s * s)
 m = mnum / (w * w * w)
 n = a / w

 dym = dy * m
 dxncos = dx * n * Cos(my)

 CalcDistance = Sqr(dym * dym + dxncos * dxncos)

 Else

 CalcDistance = "×"

 End If

End Function


Function is_need_calc(c)
 If IsEmpty(c) Or Not IsNumeric(c.Value) Then
 is_need_calc = True
 Else
 is_need_calc = False
 End If
End Function


Sub SetDistance()

  ' from
 i = 1
 If is_need_calc(Cells(1, LAT_COLUMN)) Then
 result = SetLocation(Cells(i, 1), Cells(i, LAT_COLUMN), Cells(i, LNG_COLUMN))
 End If
 from_lat = Cells(1, LAT_COLUMN).Value
 from_lng = Cells(1, LNG_COLUMN).Value
 
  ' to
 For i = 2 To MAX_ROWS
 Set cell_addr = Cells(i, 1)
 If IsEmpty(cell_addr) Or cell_addr.Value = "" Then
 Exit Sub
 End If
 Set cell_lat = Cells(i, LAT_COLUMN)
 Set cell_lng = Cells(i, LNG_COLUMN)

 If is_need_calc(cell_lat) Then
 result = SetLocation(cell_addr, cell_lat, cell_lng)
 If result = "OVER_QUERY_LIMIT" Then
  ' maybe limits of a second. wait and retry
 Application.Wait Now + TimeValue("00:00:02")
 result = SetLocation(cell_addr, cell_lat, cell_lng)
 If result = "OVER_QUERY_LIMIT" Then
  ' maybe limits of a day (24H)
 MsgBox "maybe excess limits of a day."
 Exit Sub
 End If
 End If
 End If

 DoEvents

 d = CalcDistance(from_lat, from_lng, cell_lat.Value, cell_lng.Value)
 Cells(i, DISTANCE_COLUMN).Value = d
 Next

End Sub

Google Maps API には、以下の回数制限があります。

Users of the free API:

The Google Geocoding API   |   Google Maps Geocoding API   |   Google Developers

一秒に5回までの制限はウェイトをかませて対処しています。
速度や混み具合によって変わりますが、5?10件くらいを処理しては 1秒の待ちが入って処理を続けます。
なので 24時間あたりの制限である 2500件を処理するのに 8?10分くらいかかるんじゃないでしょうか。

24時間あたりで2500回の制限は待つしかありません。
きれいに取得できたとして、20000件で 8日間はかかることになります。
24時間あたりの制限回数にかかったと思われる場合には、メッセージボックスを表示して処理を中断します。
No.1 の回答を試している場合には、既に回数を使い切っている可能性が大きいです。
24時間待ってから、試してみてください。

回数制限があるので、API を使って調べた緯度と経度はシートに残して、無駄にリクエストを出さないようにします。
緯度と経度は、AA列とAB列に残すようにしました。
既に使っている列であれば、コードの先頭にある LAT_COLUMN の値を変更してください。
経度は、緯度の次の列を使うようにしています。

最大の処理件数も、コードで持っちゃってます。
20000件以上は、MAX_ROWS の値を大きくしてください。

ヒュベニの公式については、以下のようなところを参考にしました。
先のコードでは、GRS80 という測地系を使った数値を採用しています。
http://www.amano-tec.com/apps/paceruler.html
http://hp.vector.co.jp/authors/VA002244/yacht/geo.htm
http://www.trail-note.net/tech/calc_distance/
http://homepage3.nifty.com/-ms/doc/calc_distance.htm
http://yamadarake.jp/trdi/report000001.html



ちなみに、本当に直線距離で良いんですか?
道路を使った経路の距離ではなく。

Google Maps API の Distance Matrix API というのを使うと、経路での距離も求められます。
こちらも回数制限があるので、全件求めるにはそれなりに時間がかかります。
2地点間の緯度と経度から経路距離を求めるサービスなので、この回答のコードで求めた緯度、経度が利用できます。





追記です。

それはすごいです!お手数ですがもし可能でしたら、道路を使った経路の2住所間の距離を求める方法も、お教えいただきたいのですが。
また、住所から緯度経度の取得も可能なのでしょうか?
もし可能でしたら、B?D列に「緯度」「経度」「2住所間の距離」の3つの情報を反映できると助かるのですが。

先の回答でも、緯度と経度は AA列とAB列に残すようにしてます :-)
以下の変更を加えます。

マクロのコードはこちら。

Const LAT_COLUMN = 2
Const LNG_COLUMN = LAT_COLUMN + 1
Const DISTANCE_COLUMN = 4

Const MAX_ROWS = 20000


Function SetLocation(addr, lat, lng)
 Set xhr = CreateObject("MSXML2.ServerXMLHTTP")

 result = "-"

 URL = "http://maps.google.com/maps/api/geocode/xml?sensor=false&address=" & addr.Value
 xhr.Open "GET", URL, False
 xhr.send ""
 If xhr.StatusText = "OK" Then
 
 Set doc = xhr.responseXML.DocumentElement
 Set Status = doc.FirstChild  ' status
 If Status.Text = "OK" Then
 Set geo = doc.getElementsByTagName("geometry")
 Set Location = geo(0).FirstChild
 lat.Value = Location.FirstChild.Text
 lng.Value = Location.LastChild.Text
 result = "OK"
 Else
 result = Status.Text
 Debug.Print Status.Text
 End If

 Else
 result = xhr.StatusText
 End If

 Set xhr = Nothing

 If result <> "OK" Then
 lat.Value = "×"
 lng.Value = "×"
 End If

 SetLocation = result

End Function


Function deg2rad(deg)
 PI = Application.WorksheetFunction.PI()
 deg2rad = deg * PI / 180#
End Function

' ヒュベニの公式で、2地点間の直線距離を求める
Function CalcDistance(lat1, lng1, lat2, lng2)

 If IsNumeric(lat1) And IsNumeric(lat2) Then
 a = 6378137#
 e2 = 6.69438002301188E-03
 mnum = 6335439.32708317  ' a * (1.0 - e2)

 my = deg2rad((lat1 + lat2) / 2#)
 dy = deg2rad(lat1 - lat2)
 dx = deg2rad(lng1 - lng2)

 s = Sin(my)
 w = Sqr(1# - e2 * s * s)
 m = mnum / (w * w * w)
 n = a / w

 dym = dy * m
 dxncos = dx * n * Cos(my)

 CalcDistance = Sqr(dym * dym + dxncos * dxncos)

 Else

 CalcDistance = "×"

 End If

End Function

' Google Maps Distance Matrix API を使って、2地点間の距離を求める
Function CalcDistance2(lat1, lng1, lat2, lng2)

 Set xhr = CreateObject("MSXML2.ServerXMLHTTP")

 URL = "https://maps.googleapis.com/maps/api/distancematrix/xml?" _
 & "origins=" & lat1 & "," & lng1 _
 & "&destinations=" & lat2 & "," & lng2

 xhr.Open "GET", URL, False
 xhr.send ""
 If xhr.StatusText = "OK" Then
 
 Set doc = xhr.responseXML.DocumentElement
 Set Status = doc.FirstChild  ' status
 If Status.Text = "OK" Then
 Set d = doc.getElementsByTagName("distance")
 CalcDistance2 = d(0).FirstChild.Text
 Else
 CalcDistance2 = "×"
 End If

 Else
 CalcDistance2 = "×"
 End If

 Set xhr = Nothing


End Function


Function is_need_calc(c)
 If IsEmpty(c) Or Not IsNumeric(c.Value) Then
 is_need_calc = True
 Else
 is_need_calc = False
 End If
End Function

Sub test()
 result = SetLocation(Cells(1, 1), Cells(1, 3), Cells(1, 4))
 result = SetLocation(Cells(2, 1), Cells(2, 3), Cells(2, 4))
' d = CalcDistance(Cells(1, 3).Value, Cells(1, 4).Value, Cells(2, 3).Value, Cells(2, 4).Value)
 d = CalcDistance2(Cells(1, 3).Value, Cells(1, 4).Value, Cells(2, 3).Value, Cells(2, 4).Value)
 Cells(2, 2).Value = d
End Sub

Sub SetDistance()

  ' from
 i = 1
 If is_need_calc(Cells(1, LAT_COLUMN)) Then
 result = SetLocation(Cells(i, 1), Cells(i, LAT_COLUMN), Cells(i, LNG_COLUMN))
 End If
 from_lat = Cells(1, LAT_COLUMN).Value
 from_lng = Cells(1, LNG_COLUMN).Value
 
  ' to
 For i = 2 To MAX_ROWS
 Set cell_addr = Cells(i, 1)
 If IsEmpty(cell_addr) Or cell_addr.Value = "" Then
 Exit Sub
 End If
 Set cell_lat = Cells(i, LAT_COLUMN)
 Set cell_lng = Cells(i, LNG_COLUMN)

 If is_need_calc(cell_lat) Then
 result = SetLocation(cell_addr, cell_lat, cell_lng)
 If result = "OVER_QUERY_LIMIT" Then
  ' maybe limits of a second. wait and retry
 Application.Wait Now + TimeValue("00:00:02")
 result = SetLocation(cell_addr, cell_lat, cell_lng)
 If result = "OVER_QUERY_LIMIT" Then
  ' maybe limits of a day (24H)
 MsgBox "maybe excess limits of a day."
 Exit Sub
 End If
 End If
 End If

 DoEvents

 d = CalcDistance2(from_lat, from_lng, cell_lat.Value, cell_lng.Value)
 Cells(i, DISTANCE_COLUMN).Value = d
 Next

End Sub

関数 CalcDistance2 のコードを追加して、SetDistance サブルーチンで使う距離を求める関数を置き換えました(ヒュベニの公式を使った関数も残してあります)。

因みに、距離を求めるのに使った Distance Matrix API にも回数制限があります。

Users of the free API:

The Google Distance Matrix API   |   Google Maps Distance Matrix API   |   Google Developers

距離を求めるのも計算式から、Webサービスに変えているので、その分は遅くなります。
制限にかかるとしたら、Geocoding API と同じく 24時間あたりで 2500回まで、という制限だと思います。


moon-fonduさんのコメント
a-kuma3さんありがとうございます、うまく距離が出せました! 道路を使った距離も求められるのですか!? それはすごいです!お手数ですがもし可能でしたら、道路を使った経路の2住所間の距離を求める方法も、お教えいただきたいのですが。 また、住所から緯度経度の取得も可能なのでしょうか? もし可能でしたら、B?D列に「緯度」「経度」「2住所間の距離」の3つの情報を反映できると助かるのですが。 図々しくてすみません、よろしくお願い致しますm(_ _)m

a-kuma3さんのコメント
>> お手数ですがもし可能でしたら、道路を使った経路の2住所間の距離を求める方法も、お教えいただきたいのですが。 << 回答に追記しました。

a-kuma3さんのコメント
因みに、こんなデータ(東急ハンズの店舗)で動作検証してます。 |*住所|*緯度|*経度|*距離(車)|*直線距離| |東京都千代田区丸の内1-9-1|35.6817879|139.7667614| | | |北海道札幌市中央区南一条西 6-4-1|43.0581989|141.3488937|1149264|830219.1 | |東京都中央区銀座2-2-14|35.6742582|139.765395|1730|844.6 | |東京都足立区千住3-92|35.7508316|139.8047498|13583|8396.5 | |東京都江東区豊洲2-4-9|35.6551414|139.7927659|5031|3779.5 | |東京都渋谷区宇田川町12-18|35.6619577|139.6980178|9478|6601.2 | |東京都渋谷区千駄ヶ谷5-24-2|35.6859688|139.7024831|8162|5837.1 | |東京都豊島区東池袋1-28-10|35.7298702|139.7164187|11045|7015.5 | |東京都町田市原町田6-4-1|35.5424038|139.4464903|42528|32881.4 | |神奈川県川崎市川崎区駅前本町8|35.5314724|139.7003541|22788|17730.0 | |神奈川県横浜市西区南幸1-3-1|35.4673383|139.6220148|34255|27171.3 | |神奈川県横浜市都筑区池辺町4035-1|35.5179093|139.5663144|35430|25700.9 | |千葉県船橋市浜町2-1-1|35.6856706|139.9901567|27482|20226.8 | |千葉県柏市末広町1-1|35.8622909|139.9706566|41511|27221.7 | |埼玉県さいたま市大宮区桜木町2-3|35.9068898|139.6217932|37231|28205.4 | |埼玉県富士見市山室1-1313|35.8618718|139.5452293|38914|28293.3 | |長野県長野市南千歳1-22-6|36.6439389|138.1889383|246245|177632.9 | |静岡県静岡市葵区鷹匠1-1-1|34.975512|138.3872036|177503|147896.0 | |愛知県名古屋市中村区名駅1-1-4|35.170711|136.8825448|352657|267989.7 | |三重県桑名市新西方1-22|35.072384|136.6622437|364386|290088.7 | |大阪府大阪市北区梅田3-1-1|34.7011645|135.4950183|507686|403974.5 | |大阪府大阪市中央区南船場3-4-12|34.6754731|135.502585|503328|404147.7 | |大阪府大阪市阿倍野区阿倍野筋1-6-1|34.6450961|135.5115296|506173|404379.5 | |大阪府吹田市豊津町9-40|34.7591548|135.4964091|500191|402033.5 | |京都府京都市下京区四条烏丸東入長刀鉾町27番地|35.002301|135.759666|461444|371990.7 | |兵庫県神戸市 中央区下山手通2-10-1|34.6936325|135.1908282|528308|430950.0 | |兵庫県姫路市駅前町188-1|34.827317|134.6909991|577872|471545.1 | |岡山県岡山市北区下石井1丁目2番1号|34.6612392|133.9176464|659725|544735.1 | |広島県広島市中区八丁堀16-10|34.3946077|132.4620807|812221|681646.8 | |福岡県福岡市博多区 博多駅中央街1-1|33.5905244|130.4210695|1095764|887758.8 | |熊本県熊本市中央区手取本町6-1|32.80232|130.7110047|1193614|893290.9 | |大分県大分市要町1-14|33.2332526|131.6061002|968152|797532.8 | |鹿児島県鹿児島市中央町1番地1|31.5838185|130.5418032|1363460|969099.5 | |沖縄県那覇市おもろまち4-4-9|26.2257196|127.6951712|2122458|1558697.5 | |沖縄県宜野湾市字宇地泊558-10|26.2748834|127.7299159|2119863|1552360.1 | <br>幾つかは、手で Google Map の経路探索で結果を検算しましたので、あってるんじゃないかなと思います。

moon-fonduさんのコメント
ありがとうございます! 時折、 実行時エラー91 オブジェクト変数またはWithブロック変数が設定されていません。 http://f.st-hatena.com/images/fotolife/m/moon-fondu/20150722/20150722072737.jpg?1437517687 というエラーと共にマクロが止まって http://f.st-hatena.com/images/fotolife/m/moon-fondu/20150722/20150722072738.jpg?1437517797 しまうのですが、何回かに分けて実行すればなんとかなりそうです。

a-kuma3さんのコメント
むう。status が OK で返ってるのに、distance が取得できないことがあるのですか…… やり直すと正しく動くということは、処理ができない住所があるということではないんですよね。 ちょっと試行錯誤してみます。

a-kuma3さんのコメント
他の方から指摘がありまして、Google Map API って、こういう使い方は禁止されているんだそうです。 >https://developers.google.com/maps/documentation/geocoding/intro#Limits:title> The Geocoding API may only be used in conjunction with a Google map; geocoding results without displaying them on a map is prohibited. For complete details on allowed usage, consult the Maps API Terms of Service License Restrictions. << >https://developers.google.com/maps/terms#section_10_1_3:title> (c) No Mass Downloads or Bulk Feeds of Content. You must not use the Service in a manner that gives you or any other person access to mass downloads or bulk feeds of any Content, including but not limited to numerical latitude or longitude coordinates, imagery, visible map data, or places data (including business listings). For example, you are not permitted to offer a batch geocoding service that uses Content contained in the Maps API(s). <<
関連質問

●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ