緯度・経度から地図表示用のURLを作成

1.概要

leafletで地図などを作成していますが、マーカーなどを配置する場合、必須になるのが緯度と経度です。 元となる原単位情報で住所や建物名などの表を作り、そこに緯度と経度を挿入します。緯度と経度の調べ方は、 いろいろありますが、大量の緯度と経度を調べるのは、GoogleMapsなどで一つずつ検索に住所を入れて調べてられません。 そこで住所からの逆引きという方法を用いるのが一般的です。これをアドレスマッチングと言います。筆者も以前は、 GoogleMapsのAPIをコールして自動でアドレスマッチングしていましたが、GoogleMapsにおける無料利用の範囲が制限 されてから、Web上の変換サービスを利用させて頂いています。こうして得られた緯度と経度ですが、精度の面で 検証が必要となります。ときどき変な場所の緯度と経度であったりします。今回は、検証に利用するために緯度と経度を複数の地図での URLリンクを自動で作成するツールを作成して見ました。

2.利用方法

まずは、アドレスマッチングツールを紹介します。
下記のサイト様でサービスが提供されています。住所の入ったCSVデータから一括して変換してくれます。サイトに書かれている 利用方法や注意事項を良く読んで利用して下さい。

「東京大学空間情報科学研究センター」が提供している「Geocoding Tool & Utilities」
URL : http://newspat.csis.u-tokyo.ac.jp/geocode/

利用手順は、次の通りです。
(1)緯度、経度が入力されている表を準備します。
     ※緯度と経度をCSVファイルにしているものでも可。ファイルから入力で行います。
(2)各種地図用URLリンク作成.xlsm起動します。
(3)プルダウンより対象地図を選択します。対象地図は、次の5種類から選択できます。

・google maps
・Yahoo地図
・Bing地図
・Mapon
・XRAIN GIS版

(4)準備してある表の緯度と経度をコピーして、A5から貼付します。
(5)ファイルから貼付ボタンをクリックします。
(6)地図表示用のURL一覧がE5から表示され、外部ファイルにテキスト形式で出力されます。
(7)ファイルから入力の場合は、ファイルから入力ボタンをクリックして、緯度、経度でカンマ区切
     りされたCSVファイル選択します。

3.ソースコード

ソースコードは、下記の通りです。Excel VBAマクロで作成してあります。
ThisWorkbookは、シート上に配置したコンボボックスにブック起動時に 値(地図名)をセットするための処理をしています。

ThisWorkbook

1 2 3 4 5 6 7 8 9 10

'***** 地図サイト選択 ***** Private Sub Workbook_Open()    With Worksheets("MAIN").MapSelect         .AddItem ("google maps")         .AddItem ("Yahoo地図")         .AddItem ("Bing地図")         .AddItem ("Mapon")         .AddItem ("XRAIN GIS版")    End With End Sub

Sheet1(MAIN)が、メインの処理ルーチンです。 特に難しい部分はありません。5つの地図のURLパラメータに緯度と経度を挿入しているだけです。 該当行は、85,87,94,101,108行です。また、ファイルへの出力部分は、125行から141行目までで行っています。 CSVファイルからの読み込み処理では、 QueryTablesメソッドを使ってファイルを読み込んでいるため、 比較的高速で処理します。便利な方法ですので、いろいろと使えます。

Sheet1(MAIN)

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165

'* **************************************************************************** '*            緯度・経度から地図表示用のURL作成ツール  Ver 1.0 '* '*    [ 概要 ] '*    本ツールは、複数の緯度・経度から、地図提供サイトを指定して、リンク用のURLを '*    自動作成して出力するものです。また、XRAIN GIS版(国土交通省)より指定した '*    緯度・経度から、周辺の雨雲レーダの状況確認できるようにリンク用のURLを作成 '*    します。 '* '* '* ****************************************************************************    '***** 地図を選択した時 ***** Private Sub MapSelect_Change()     '***** 選択された値を表示 *****     'MsgBox(MapSelect.Value) End Sub   '***** 全て削除 ***** Private Sub dellAll_Click()     'シートデータをクリア(セルの属性定義を維持したままデータのみを削除)      If Range("B5") <> "" Then           Range("B5:E1048576").SpecialCells(xlCellTypeConstants, 23).ClearContents      End If End Sub   '***** ファイルから貼付 ***** Private Sub Filepast_Click()    '画面更新を停止する     Application.ScreenUpdating = False       Call UrlGen     Call outmode       Worksheets("MAIN").Range("A1").Select      '画面更新を開始する     Application.ScreenUpdating = True     MsgBox "処理が終了しました。" End Sub   '***** 外部ファイルから入力の場合 ***** Private Sub Fileset_Click()    '画面更新を停止する     Application.ScreenUpdating = False       Call CSVInput     Call UrlGen     Call outmode       Worksheets("MAIN").Range("A1").Select      '画面更新を開始する     Application.ScreenUpdating = True     MsgBox "処理が終了しました。" End Sub   '***** URL生成処理 ***** Private Sub UrlGen() Dim i As Long Dim lngLastRow As Long      '最終行取得    With ThisWorkbook.Worksheets("MAIN")         lngLastRow = .Cells(1048576, "B").End(xlUp).Row    End With      '***** 緯度・経度データが未入力の場合 *****    If lngLastRow = 4 Then       MsgBox "緯度・経度データがありません。"       End    End If      '/////// 処理開始 ///////      '***** google mapsの場合 *****    If (MapSelect.Value) = "google maps" Then       i = 0       For i = 1 To lngLastRow - 4           Cells(i + 4, 5).Value = "https://maps.google.co.jp/maps?q=" & Cells(i + 4, 2) & "," & Cells(i + 4, 3)       Next i    End If    '***** Yahoo地図の場合 *****    If (MapSelect.Value) = "Yahoo地図" Then       i = 0       For i = 1 To lngLastRow - 4           Cells(i + 4, 5).Value = "https://map.yahoo.co.jp/maps?type=scroll&lat=" & Cells(i + 4, 2) & "&lon=" & Cells(i + 4, 3) & "&mode=map&pointer=on&z=18"       Next i    End If    '***** Bing地図の場合 *****    If (MapSelect.Value) = "Bing地図" Then       i = 0       For i = 1 To lngLastRow - 4           Cells(i + 4, 5).Value = "http://www.bing.com/maps/?v=2&cp=" & Cells(i + 4, 2) & "~" & Cells(i + 4, 3) & "&style=r&vl=18"       Next i    End If    '***** Mapion地図の場合 *****    If (MapSelect.Value) = "Mapion地図" Then       i = 0       For i = 1 To lngLastRow - 4           Cells(i + 4, 5).Value = "http://www.mapion.co.jp/m2/" & Cells(i + 4, 2) & "," & Cells(i + 4, 3) & ",16/"       Next i    End If    '***** XRAIN GIS版の場合 (周辺の雨雲レーダ) *****    If (MapSelect.Value) = "XRAIN GIS版" Then       i = 0       For i = 1 To lngLastRow - 4           Cells(i + 4, 5).Value = "http://www.river.go.jp/x/krd0107010.php?lon=" & Cells(i + 4, 3) & "&lat=" & Cells(i + 4, 2) & "&opa=0.4&zoom=128&leg=0&ext=0"       Next i    End If End Sub   '***** 生成ファイル外部出力処理 ***** Private Sub outmode() Dim i            As Long Dim langLastRow  As Long Dim csvBuf, Temp As String Dim strFNAME     As String      '***** 最終行を取得 *****    With ThisWorkbook.Worksheets("MAIN")       langLastRow = Cells(1048576, "B").End(xlUp).Row    End With      '***** 出力用のtxtファイル作成 *****    For i = 5 To langLastRow       Temp = Cells(i, 5).Value & vbCrLf       csvBuf = csvBuf + Temp    Next i      '***** ファイルをShift-JIS形式でセーブする *****    strFNAME = ThisWorkbook.Path & "¥" & "Map_" & Format(Now(), "yyyymmddhhmmss") & ".txt"      With CreateObject("ADODB.Stream")         .Charset = "SJIS"         .Open         .WriteText csvBuf         '***** 1:ファイル有り時上書きしない 2:上書きする *****         .SaveToFile strFNAME, 2         .Close    End With End Sub   '***** CSV-Read (高速版) ***** Sub CSVInput()    Dim varFileName As Variant      ChDir ActiveWorkbook.Path    varFileName = Application.GetOpenFilename(FileFilter:="CSVファイル(*.csv),*.csv", _    Title:="CSVファイルの選択")    If varFileName = False Then       '画面更新を開始する       Application.ScreenUpdating = True       End    End If      '【注意】ファイルのセル開始位置は、B5から(※任意に変更のこと)    With ActiveSheet.QueryTables.Add(Connection:="text;" & varFileName, Destination:=Range("B5"))          .AdjustColumnWidth = False          .TextFilePlatform = 932 'Shift=Jis          .TextFileCommaDelimiter = True          .Refresh BackgroundQuery:=False          .Delete    End With End Sub

4.ダウンロード

提供するソースコードのライセンスは、CC0 (クレジット表示不要、改変可、商用可) とします。自由に利用して頂いてかまいません。 尚、データの取得やプログラム実行において損害等が生じた場合は、筆者は一切の責任も負いません。全て自己責任でお願いします。

紹介したExcel VBAマクロは、下記よりダウンロードして下さい。

ダウンロード