Excelで住所から最寄駅を、一括で検索する方法を探しております。

Question

moon-fondu

236

235もっと見る

2000pt

コンピュータ学習・教育

Excelで住所から最寄駅を、一括で検索する方法を探しております。

住所から最寄駅を1つ1つ調べる方法はいろんなページで紹介されていたのですが、一括で数千～数万件のデータを調べる方法は紹介されていないようで。
唯一、

住所　名称から最寄駅等を取得する - ひろボックス　～備忘録～
http://d.hatena.ne.jp/hiroroEX/20131207/1386420196

に秀逸なマクロがあり、実行するとたまに最寄駅や方角・徒歩何分かまでも取得できるのですが、取得できない時もあります。添付画像をご覧いただきたいのですが「m_Return(2) = m_DirectionElements.Item(0).Text」の部分で、マクロが停止します。「実行時エラー91；オブジェクト変数またはWithブロック変数が設定されていません」も出てきます。
マクロのセキュリティレベルや、PC等を変えると、たまに動作して結果を出力してくれるのですが。
ひろボックスさんで紹介されているマクロのコードを変更し、安定して稼働するようにしていただけないでしょうか。
他にも、何か一括で住所から最寄駅を検索する方法（可能でしたら距離等も）がありましたら、お力添えをいただきたいです。住所が難しいようでしたら緯度経度からでも構いません。
よろしくお願いします。

回答の条件

1人10回まで

登録：2014/11/28 07:44:53
終了：2014/12/03 04:52:44

※ 有料アンケート・ポイント付き質問機能は2023年2月28日に終了しました。

コメントはまだありません

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

リクエスト送信済

回答リクエストを送信したユーザーはいません

a-kuma3 · Accepted Answer · 2014-11-28T09:42:20+09:00

最寄り駅を検索する関数 GetListOfNearestStation が間違ってたので、書き直してみました。

'最寄駅を検索するファンクション
'引数　 ByRef参照渡し
'       検索する建物名
Private Function GetListOfNearestStation(ByRef argLocation As String) As String()
    Dim m_Return(5) As String
    Dim m_Uri As String
    Dim m_NameElements As Object
    Dim m_LineElements As Object
    Dim m_DirectionElements As Object
    Dim m_DistanceElements As Object
    Dim m_TraveltimeElements As Object
    Dim i As Integer

    '住所入っていた場合
    If Len(argLocation) > 0 Then
        'SimpleAPI「最寄り駅Webサービスを利用
        '緯度　経度を指定して最寄駅を検索
        m_Uri = "http://map.simpleapi.net/stationapi?output=xml&y=" & _
                    Replace(argLocation, ",", "&x=")
        Set xhr = CreateObject("MSXML2.XMLHTTP")
        xhr.Open "GET", m_Uri, False
        xhr.Send
            '取得結果を格納
            
            Set elements = xhr.responseXML.DocumentElement
' ★ここから
            Set firstStation = elements.getElementsByTagName("station").Item(0)
            Set child = firstStation.ChildNodes
            
            For i = 0 To child.Length - 1
                
                Select Case child.Item(i).NodeName
                Case "name"
                    m_Return(0) = child.Item(i).Text
                Case "line"
                    m_Return(1) = child.Item(i).Text
                Case "direction"
                    m_Return(2) = child.Item(i).Text
                Case "distance"
                    m_Return(3) = child.Item(i).Text
                Case "traveltime"
                    m_Return(4) = child.Item(i).Text
                End Select

            Next
' ★ここまでを、書き換えてます
            
    Else
        'ReDim m_Return(0)
    End If
    
    GetListOfNearestStation = m_Return
    
    'オブジェクトの破棄処理
    Set m_DirectionElements = Nothing
    Set m_LineElements = Nothing
    Set m_DirectionElements = Nothing
    Set m_DistanceElements = Nothing
    Set m_TraveltimeElements = Nothing
End Function

どこをいじったか分かりやすいように、既に使わなくなった変数も残してます。邪魔なら、消してください。

ちょこっと解説。

駅によって、取得するデータに「方角」に当たる "direction" というデータが入っていない駅があるようです。

住所が「広島県東広島市八本松」の場合には、八本松駅しか検索結果がなく、これに方角のデータがないので、エラーになってました。

<result>
    <station>
        <name>八本松駅</name>
        <furigana>はちほんまつえき</furigana>
        <line>JR山陽本線</line>
        <url>http://map.simpleapi.net/station/hiroshima/hachihonmatsu/</url>
        <city>東広島市</city>
        <prefecture>広島県</prefecture>
        <distance>0</distance>
        <distanceM/>
        <distanceKm/>
        <traveltime>徒歩3分以内</traveltime>
    </station>
</result>

また、住所が「広島県広島市中区胡町」の場合には、検索結果に胡町駅、銀山町駅、八丁堀駅とデータが続くのですが、胡町駅には方角のデータがなく、次の銀山町駅の方角を間違って取得していました。

<result>
    <station>
        <name>胡町駅</name>
        <furigana>えびすちょうえき</furigana>
        <line>広島電鉄[本線]</line>
        <url>http://map.simpleapi.net/station/hiroshima/ebisuchou/</url>
        <city>広島市中区</city>
        <prefecture>広島県</prefecture>
                                            <!-- ※ direction のデータがない -->
        <distance>60</distance>
        <distanceM>60m</distanceM>
        <distanceKm>0.1km</distanceKm>
        <traveltime>徒歩3分以内</traveltime>
    </station>
    <station>
        <name>銀山町駅</name>
        <furigana>かなやまちょうえき</furigana>
        <line>広島電鉄[本線]</line>
        <url>http://map.simpleapi.net/station/hiroshima/kanayamachou/</url>
        <city>広島市中区</city>
        <prefecture>広島県</prefecture>
        <direction>東</direction>           <!-- ※ こっちを拾ってしまっている -->
        <directionReverse>西</directionReverse>
        <distance>140</distance>
        <distanceM>140m</distanceM>
        <distanceKm>0.1km</distanceKm>
    <traveltime>徒歩2分以上</traveltime>
</station>

追記です。

9000件ぐらいあるので、「For i = 0 To 1000」の部分を「For i = 0 To 9000」にして実行してみたのですが。
どうもうまく取得できませんでして。通常、A2セルからデータを並べれば1000件ぐらいでしたら取得できたりするのですが、数字を変えたりしたからでしょうか、1件も取得できない場合等があります。

ふたつの問題があることが分かりました。

ひとつ目は、Google Geocoding API の制限です。

Google Geocoding API 使用時のクエリ制限として、1 日あたりの位置情報リクエストが 2,500 回に制限されています（Google Maps API for Business をご利用の場合は、1 日あたり 100,000 件までリクエストを実行できます）。
Google Geocoding API - Google Maps API ウェブサービス — Google Developers

この回数を超えると、位置情報が取得できなくなるので、1件も取得できない、という結果になります。
これは、使う側には、どうしようもないので、制限内の件数で、For ループの開始位置を変えて、複数日に分けて実行するしかありません。

もうひとつは、オブジェクトの開放漏れがあったことです。
ふたつの Web API を使うために MSXML2.XMLHTTP というオブジェクトを使っていますが、こいつの開放がされていません。
環境によって、何件まで取得できるかは変わってくると思いますが、ぼくの環境では 1300件くらいでメモリ不足になりました。

というわけで、見直したソースが以下になります（全てを載せてます）。

Dim xhr

'最寄駅を検索するサンプル
Sub Sample_search_near_station()
    Dim i As Integer
    Dim m_ListOfStation() As String
    Dim address As String
    Dim Sheet As Object 'Excel.Worksheet
    Set Sheet = Worksheets("sheet1")

    Set xhr = CreateObject("MSXML2.XMLHTTP")    ' ★一回だけ生成

    'ワークシートから住所を取得
    Worksheets("sheet1").Select
    
    'ワークシートに描画しない
    Application.ScreenUpdating = False
    
    n_not_found = 0
    
    '住所欄を順次取得していく
    For i = 0 To 9000
        '空行なら抜ける
        If (Sheet.Cells(2 + i, 1) = "") Then
            Exit For
        Else
        address = Sheet.Cells(2 + i, 1).Value
        '最寄駅を検索するサブプロシージャの呼び出し
        m_ListOfStation = GetListOfNearestStation(GetLocation(address))
        'UBOUND関数配列の名前を指定する
        'For j = 0 To (UBound(m_ListOfStation) / 5 - 1)
        
        ' ★3回連続で取得に失敗したら、処理を中断する
        If m_ListOfStation(0) = "" Then
            not_found_count = not_found_count + 1
            If not_found_count > 3 Then
                Exit For
            End If
        Else
            not_found_count = 0
        End If
            Sheet.Cells(2 + i, 2) = m_ListOfStation(0)
            Sheet.Cells(2 + i, 3) = m_ListOfStation(1)
            Sheet.Cells(2 + i, 4) = m_ListOfStation(2)
            Sheet.Cells(2 + i, 5) = m_ListOfStation(3)
            Sheet.Cells(2 + i, 6) = m_ListOfStation(4)
        'Next
        End If
    'DoEventsの実行
    '
    DoEvents
    
    Next
    
    '結果を描画する
    Application.ScreenUpdating = True

    Set xhr = Nothing

End Sub




'最寄駅を検索するファンクション
'引数　 ByRef参照渡し
'       検索する建物名
Private Function GetListOfNearestStation(ByRef argLocation As String) As String()
    Dim m_Return(5) As String
    Dim m_Uri As String
    Dim m_NameElements As Object
    Dim m_LineElements As Object
    Dim m_DirectionElements As Object
    Dim m_DistanceElements As Object
    Dim m_TraveltimeElements As Object
    Dim i As Integer

    '住所入っていた場合
    If Len(argLocation) > 0 Then
        'SimpleAPI「最寄り駅Webサービスを利用
        '緯度　経度を指定して最寄駅を検索
        m_Uri = "http://map.simpleapi.net/stationapi?output=xml&y=" & _
                    Replace(argLocation, ",", "&x=")
'        Set xhr = CreateObject("MSXML2.XMLHTTP")
        xhr.Open "GET", m_Uri, False
        xhr.Send
            '取得結果を格納
            
            Set elements = xhr.responseXML.DocumentElement
            
            If elements.getElementsByTagName("station").Length > 0 Then     ' ★ここを追加
                Set firstStation = elements.getElementsByTagName("station").Item(0)
                
                Set Child = firstStation.ChildNodes
                
                For i = 0 To Child.Length - 1
                    
                    Select Case Child.Item(i).NodeName
                    Case "name"
                        m_Return(0) = Child.Item(i).Text
                    Case "line"
                        m_Return(1) = Child.Item(i).Text
                    Case "direction"
                        m_Return(2) = Child.Item(i).Text
                    Case "distance"
                        m_Return(3) = Child.Item(i).Text
                    Case "traveltime"
                        m_Return(4) = Child.Item(i).Text
                    End Select

                Next        ' ★ここを追加
            End If
            
    Else
        'ReDim m_Return(0)
    End If
    
    GetListOfNearestStation = m_Return
    
    'オブジェクトの破棄処理
    Set m_DirectionElements = Nothing
    Set m_LineElements = Nothing
    Set m_DirectionElements = Nothing
    Set m_DistanceElements = Nothing
    Set m_TraveltimeElements = Nothing
End Function

'緯度　経度を取得するファンクション
'引数　検索する建物
Public Function GetLocation(ByRef argAddressString As String) As String
    Dim m_Uri As String
    'Debug.Print argAddressString
    If Len(argAddressString) > 0 Then
        m_Uri = "http://maps.googleapis.com/maps/api/geocode/xml?address=" & _
        EncodeURI(argAddressString) & "&sensor=false"
        'With CreateObject("MSXML2.XMLHTTP")
        '    .Open "GET", m_Uri, False: .Send
        '
        '分割して記述した例が下
        

'        Set xhr = CreateObject("MSXML2.XMLHTTP")
        xhr.Open "GET", m_Uri, False
        xhr.Send
        'Debug.Print m_Uri
            'With CreateObject("MSXML2.XMLHTTP").responseXML
                '取得結果を格納
                Set elements = xhr.responseXML.DocumentElement
                '情報を取得できたら格納
                If elements.getElementsByTagName("status").Item(0).Text = "OK" Then
                    'locationタグの読み込み
                    '緯度経度間の空白を,に置換
                    '置換例 35.7100327,139.8107155
                    GetLocation = Replace(elements.getElementsByTagName("location").Item(0).Text, " ", ",")
                End If
            'End With
        'End With
    End If
End Function
'URLエンコードを行うファンクション
Private Function EncodeURI(ByVal argString As String) As String
    argString = Replace(Replace(argString, "\", "\\"), "'", "\'")
    With CreateObject("HtmlFile")
        .parentWindow.execScript "document.write(encodeURIComponent('" & argString & "'));", "JScript"
        EncodeURI = .Body.innerHTML
    End With
End Function

実は、この回答を書いている時点で、ぼくも Geocoding API の回数制限に引っかかってしまい、動作の確認はできていませんが、多分、2500件までは取得できるはずです。

ぽつぽつ歯抜けがありますが、2519 行目までは処理できました。
データが取得できた住所は 2486 行ありました。
三回連続で最寄り駅を取得できなかった場合には、For ループを中断するようにしてあります。

二日目に入って、また、再開できました。
どうやら回数制限は、引っかかってから 24時間（くらい）経つと解除されるようです。
9000件だと、のんびりやって四日。
テザリングなど、別回線を用意できれば、もっと短縮することができると思います。

Excelで住所から最寄駅を、一括で検索する方法を探しております。

ベストアンサー

a-kuma3496721512014/11/28 09:42:20

コメント（0件)

この質問への反応（ブックマークコメント）