Excelに保存してある複数の住所(例えば、昔の小学校の同級生の現住所200個)から、指定した到着時刻、場所(例えば12:00にスカイツリー)への、おのおのの「所要時間」「出発するべき時刻」を調べ、その結果を同じExcelのシートに記録するようなことはできますか?
いろいろと調べていると、VBAでgoogle mapsのような地図検索をIEで起動する手法を工夫すれば何とかできるのではないか…と感じてはいるのですが、どうもうまく突破できません。
ヒントになるVBAを教えていただくことでもけっこうですので、ご存知の方がいらっしゃいましたらよろしくお願いいたします。
Google Distance Matrix API
https://developers.google.com/maps/documentation/distancematrix/?hl=ja
を利用して出発場所、到着場所のリストからそれぞれの所要時間を出すスクリプトを作ってみました。
出発すべき時刻は求めていませんが、所要時間がわかれば到着時刻から逆算することで求められるかと思います。
次のようなExcel表を用意して、
A列(出発場所) | B列(到着場所) |
---|---|
広島駅 | 東京駅 |
京都駅 | 東京駅 |
神奈川駅 | 東京駅 |
下記のVBAスクリプト(GetAllDistanceTime)を実行してみてください。
Public Function GetAllDistanceTime() Set r = Range("A1") Do While r.Value <> "" r.Offset(0, 2).Value = GetDistanceTime(r.Offset(0, 0).Value, r.Offset(0, 1).Value) Set r = r.Offset(1, 0) Loop End Function Private Function GetDistanceTime(sFrom, sTo) As String sApiUrl = "http://maps.googleapis.com/maps/api/distancematrix/xml?origins={0}&destinations={1}&sensor=false&language=ja" sSendUrl = sApiUrl sSendUrl = Replace(sSendUrl, "{0}", UrlEncode(sFrom)) sSendUrl = Replace(sSendUrl, "{1}", UrlEncode(sTo)) Set oHttpReq = CreateObject("MSXML2.XMLHTTP") oHttpReq.Open "GET", sSendUrl, False Call oHttpReq.send(Null) Set oDomDoc = CreateObject("MSXML2.DOMDocument") Call oDomDoc.loadXML(oHttpReq.responseText) GetDistanceTime = oDomDoc.selectSingleNode("//DistanceMatrixResponse/row/element/duration/text").Text Set oHttpReq = Nothing Set oDomDoc = Nothing End Function Private Function UrlEncode(sText) As String If sText = "" Then Exit Function With CreateObject("ScriptControl") .Language = "JScript" With .CodeObject UrlEncode = .encodeURI(sText) End With End With End Function
ありがとうございました。VBAの知識が浅いので、解読しながらでしたが、なるほど!と感激しました。こんなに早く書き込んでいただいているとはつゆと思わずお礼が遅くなり本当に申し訳ありませんでした。
2012/06/30 22:38:16自分でももっとVBAを勉強しながら発展させていこうと思います。