Следуйте этой статье и создайте свой собственный географический инструмент, с помощью которого вы сможете получить координаты широты и долготы для адреса. Подобные преобразователи обычно используются брокерами по недвижимости.
Скачать сейчас
Если вы хотите сtart использовать программное обеспечение как можно скорее, то вы можете:
Загрузите программное обеспечение сейчас
В противном случае, если вы хотите сделать своими руками, вы можете прочитать содержимое ниже.
Давайте подготовим графический интерфейс
Все, что вам нужно, это один лист Excel, и вы можете назвать лист в соответствии с вашими потребностями. В этом примере я использую имя листа по умолчанию «Лист1». Следующим шагом будет добавление необходимых заголовков на этот лист. Конвертер широты и долготы дает точный результат для адреса, который мы передаем, если входные данные включают пригород, штат, postкод и страна. Как показано на изображении, подготовьте заголовки. Давайте добавим широту и долготу в качестве последних двух столбцов. Нам также нужна кнопка, позволяющая пользователю выполнить преобразование. Итак, давайте вставим фигуру и заполним ее цветом, чтобы она выглядела как кнопка.
Давайте сделаем его функциональным
Предоставленный здесь скрипт следует скопировать в новый модуль. Не забудьте сохранить книгу как файл книги с поддержкой макросов. Подпрограмма «Найти это» должна быть прикреплена к кнопке, которую мы только что создали.
Давайте проверим это
Добавьте адрес вместе с другой информацией в соответствующие столбцы. Нажмите кнопку, чтобы запустить макрос, который будет отображать широту и долготу для всех адресов, перечисленных на листе. Макрос будетtart в строке 2 и будет продолжать работать, пока не достигнет пустой строки.
Как это работает?
С помощью скрипта мы создали две функции. Один для получения значения Lat, а другой для получения значения Long. Используя цикл FOR, мы передаем каждый адрес этим функциям и отображаем результат на экране.
Сценарий
Function GETLAT(v_address As String, v_suburb As String, v_state As String, v_postcode As Long)
Dim URl As String, lastRow As Long
Dim xmlHttp As Object, html As Object, objResultDiv As Object, objH3 As Object, link As Object
URl = "https://maps.googleapis.com/maps/api/geocode/xml?address=" & Application.WorksheetFunction.Substitute(v_address, " ", "+") & Application.WorksheetFunction.Substitute(v_suburb, " ", "+") & Application.WorksheetFunction.Substitute(v_state, " ", "+") & Application.WorksheetFunction.Substitute(v_postcode, " ", "+") & ",Australia"
Set xmlHttp = CreateObject("MSXML2.XMLHTTP")
xmlHttp.Open "GET", URl, False
xmlHttp.setRequestHeader "Content-Type", "text/xml"
xmlHttp.send
Set html = CreateObject("htmlfile")
html.body.innerhtml = xmlHttp.ResponseText
v_string = html.body.innerhtml
x = InStr(1, v_string, "<LAT>")
If x <> 0 Then
y = InStr(x + 5, v_string, "</LAT>")
GETLAT = Mid(v_string, x + 5, y - (x + 5))
End If
End Function
Function GETLNG(v_address As String, v_suburb As String, v_state As String, v_postcode As Long)
Dim URl As String, lastRow As Long
Dim xmlHttp As Object, html As Object, objResultDiv As Object, objH3 As Object, link As Object
URl = "https://maps.googleapis.com/maps/api/geocode/xml?address=" & Application.WorksheetFunction.Substitute(v_address, " ", "+") & Application.WorksheetFunction.Substitute(v_suburb, " ", "+") & Application.WorksheetFunction.Substitute(v_state, " ", "+") & Application.WorksheetFunction.Substitute(v_postcode, " ", "+") & ",Australia"
Set xmlHttp = CreateObject("MSXML2.XMLHTTP")
xmlHttp.Open "GET", URl, False
xmlHttp.setRequestHeader "Content-Type", "text/xml"
xmlHttp.send
Set html = CreateObject("htmlfile")
html.body.innerhtml = xmlHttp.ResponseText
v_string = html.body.innerhtml
x = InStr(1, v_string, "<LNG>")
If x <> 0 Then
y = InStr(x + 5, v_string, "</LNG>")
GETLNG = Mid(v_string, x + 5, y - (x + 5))
End If
End Function
Sub FindThis()
For r = 2 To 5
Range("F" & r).Value = GETLAT(Range("A" & r).Value, Range("B" & r).Value, Range("C" & r).Value, Range("D" & r).Value)
Range("G" & r).Value = GETLNG(Range("A" & r).Value, Range("B" & r).Value, Range("C" & r).Value, Range("D" & r).Value)
Next r
End Sub
Если вы не получаете должных результатов с помощью скрипта, вероятной причиной может быть поврежденный Excel. Затем вы можете использовать Инструмент для восстановления файлов Excel такие как DataNumen Excel Repair исправить Эксель.
Об авторе:
Ник Випонд — эксперт по восстановлению данных в DataNumen, Inc., которая является мировым лидером в области технологий восстановления данных, включая исправить проблему с документом и программные продукты для восстановления Outlook. Для получения дополнительной информации посетите www.datanumen.com