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

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

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

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

1417128293
●拡大する


●質問者: moon-fondu
●カテゴリ:コンピュータ 学習・教育
○ 状態 :終了
└ 回答数 : 1/1件

▽最新の回答へ

1 ● a-kuma3
●2000ポイント ベストアンサー

最寄り駅を検索する関数 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件だと、のんびりやって四日。
テザリングなど、別回線を用意できれば、もっと短縮することができると思います。


moon-fonduさんのコメント
ありがとうございます。 さっそく、a-kuma3さんのマクロを実行しようと思ったのですが。 なぜでしょう、マクロを選択出来ず、実行ができないのですが・・・ http://f.st-hatena.com/images/fotolife/m/moon-fondu/20141129/20141129005743.jpg?1417190273 すみません、考えうる原因をお教えいただけないでしょうか。 お手数お掛け致します。

moon-fonduさんのコメント
あっ、すみません、全体を俯瞰してなかったです。修正箇所のみ書いてくださったんですね。 はやとちりしてしまいました!もう1度試してみます!!

a-kuma3さんのコメント
一応、全体も貼っておきます。回答に書いた関数以外は、はてなダイアリーにあるソースのまんまです。 >|vb| '最寄駅を検索するサンプル 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") 'ワークシートから住所を取得 Worksheets("sheet1").Select 'ワークシートに描画しない Application.ScreenUpdating = False '住所欄を順次取得していく For i = 0 To 1000 '空行なら抜ける 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) 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 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 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 '緯度 経度を取得するファンクション '引数 検索する建物 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 ||<

moon-fonduさんのコメント
a-kuma3さんありがとうございます! うまく最寄り駅や目的地までの方角も取得することが出来ました! ただ、1点気になる点がありまして。 参照先にデータがないからでしょうか、たまに「実行時エラー91;オブジェクト変数またはWithブロック変数が設定されていません」というエラーが出て、デバッグ「Set Child = firstStation.ChildNodes」の部分が黄色くなります。 http://f.st-hatena.com/images/fotolife/m/moon-fondu/20141129/20141129211053.png?1417263352 山梨県南アルプス市桃園 山梨県南アルプス市飯野 等なのですが。 南アルプス市は問題なく取得できたのです。 http://f.st-hatena.com/images/fotolife/m/moon-fondu/20141129/20141129211054.png?1417263322 ここまでしていただいて更に図々しいお願いで恐縮なのですが・・・もし最寄り駅等が取得できなかった場合は、そのデータを無視して、データのある最後の行までマクロを稼動させることは可能でしょうか? サンプルファイルも一応置いたのですが http://xfs.jp/hYctjp 、もしよければお時間のあるときによろしくお願い致します。

a-kuma3さんのコメント
>> もし最寄り駅等が取得できなかった場合は、そのデータを無視して、データのある最後の行までマクロを稼動させることは可能でしょうか? << 判定を追加しました。 if 文をひとつ追加しただけです。 念のため、全コードを貼っておきます。 >|vb| '最寄駅を検索するサンプル 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") 'ワークシートから住所を取得 Worksheets("sheet1").Select 'ワークシートに描画しない Application.ScreenUpdating = False '住所欄を順次取得していく For i = 0 To 1000 '空行なら抜ける 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) 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 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 ||<

moon-fonduさんのコメント
ありがとうございます。 ただ、やはりデータが多いと途中で止まったりしてしまいます。 何度も度々すみません。 こちら http://xfs.jp/jE50Fw に上げたデータは、vectorよりダウンロード http://www.vector.co.jp/soft/data/home/se441833.html して編集した、全国の駅一覧の住所です。 9000件ぐらいあるので、「For i = 0 To 1000」の部分を「For i = 0 To 9000」にして実行してみたのですが。 どうもうまく取得できませんでして。通常、A2セルからデータを並べれば1000件ぐらいでしたら取得できたりするのですが、数字を変えたりしたからでしょうか、1件も取得できない場合等があります。 既に私が設定しましたポイント以上のご指導をa-kuma3さんからは頂いていると思いますが、この9000件のデータを最初から最後まで、マクロをかけ、最寄駅や方角を取得することは出来ませんでしょうか。 何度もお手数お掛け致しますがよろしくお願い致します。

a-kuma3さんのコメント
>> 数字を変えたりしたからでしょうか、1件も取得できない場合等があります。 << 同じ A列のデータで、取得できたり、できなかったり、ということは、データの形が想定外とか、そういうことが原因じゃない、ということですね。 ちょっと気になるところがあるので、調べてみます。

moon-fonduさんのコメント
たびたびすみません・・・お時間のある時で構いませんので、よろしくお願い致します。

a-kuma3さんのコメント
回答に追記しました。 オブジェクトの開放漏れがあったのと、Google の Geocode API の回数制限の問題がありました。

moon-fonduさんのコメント
ありがとうございます!数日に分けたり、Wi-Fiでやったり、小分けして変換していきたいと思います! ありがとうございました!!

a-kuma3さんのコメント
質問開始時のポイントも十分高額だったのに、お気遣いありがとうございます。 情報共有をふたつほど。 ひとつ目は、元のスクリプトの罠みたいなやつなんですが、住所を参照するセルを指定するのに、このような書き方になってます。 >|vb| If (Sheet.Cells(2 + i, 1) = "") Then ||< Google Geocode API の回数制限がありますから、一日目が 2500 行まで進んだとします。 次の日になって制限が解除されたときに、次の 2501 行目から検索を始めようと思って、ループのカウンタに使ってる i の範囲を、素直に行で 2501 から、と指定して再開すると、<span style="font-size:large; color:red;">2 + i</span> のセルを参照しますから、+2 した行から始まることになり、二行ほどデータの探索を飛ばしてしまうという... 他にデータの抜けが無ければ、検索語の結果を見れば分かるのですが、実際には歯抜けがありますから、後でデータを見ても気が付かない可能性が大きいです。 ふたつ目は、これ。 >> <u style="color: red;">ぽつぽつ歯抜けがあります</u>が、2519 行目までは処理できました。 << データに歯抜けがあることが気になっていました。 例えば、シートの 5014 行目の「滋賀県伊香郡木之本町大字木之本」。 これを指定したときの Geocode API の応答が以下のようになってます。 >|| <GeocodeResponse><status>ZERO_RESULTS</status></GeocodeResponse> ||< ですが、その住所を Google Map で検索すると、[https://goo.gl/maps/GvYMw:title=地図では検索できます]し、近くにはJR北陸本線の木之本駅があります。 どうやら、これが原因っぽいです。 >http://ja.wikipedia.org/wiki/%E9%95%B7%E6%B5%9C%E5%B8%82:title> 2010年(平成22年)1月1日 - 東浅井郡虎姫町・湖北町・伊香郡高月町・木之本町・余呉町・西浅井町を編入。人口は大津市と草津市に次ぐ県下第三の都市となった。 << でも、再編だけでこれだけの歯抜けが出るのも、ちょっと解せません。もう少しサンプル。 -北海道厚岸郡浜中町大字後静村字姉別市街<br>Google Map でも検索できない。<br>北海道厚岸郡浜中町 なら OK。 -北海道釧路郡釧路町鳥通原野<br>「原野」がどうも余計みたいです。鳥通までなら OK 。 -秋田県大仙市下鶯野<br>Google Map でも見つからない。<br>うーん、郵便番号は検索できるのに。 -岩手県岩手郡滝沢村大字篠木<br>Geocode API では探せているのに、最寄り駅Webサービスでの検索結果が空。<br>近くに田沢湖線 大釜駅があるので、最寄り駅Webサービスの問題かと思われる。 んー、ケースバイケースのようです。

moon-fonduさんのコメント
複雑ですね?いろんな要因で歯抜けが出てしまうのは仕方ないですね! でも大体取得できているので満足です、ありがとうございます(^O^)
関連質問

●質問をもっと探す●



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