Следуйте этой статье и создайте свой собственный географический инструмент, с помощью которого вы сможете получить координаты широты и долготы для адреса. Подобные преобразователи обычно используются брокерами по недвижимости.
Скачать сейчас
Если вы хотите начать использовать программное обеспечение как можно скорее, то можете:
Загрузите программное обеспечение сейчас
В противном случае, если вы хотите сделать своими руками, вы можете прочитать содержимое ниже.
Давайте подготовим графический интерфейс
Вам понадобится всего один лист Excel, и вы можете назвать его по своему усмотрению. В этом примере я использую имя листа по умолчанию «Sheet1». Следующий шаг — добавить необходимые заголовки на этот лист. Конвертер широты и долготы даст точный результат для введенного адреса, если в поле ввода указаны район, штат, почтовый индекс и страна. Как показано на изображении, подготовьте заголовки. Добавим широту и долготу в качестве последних двух столбцов. Нам также нужна кнопка, чтобы пользователь мог выполнить конвертацию. Поэтому давайте вставим фигуру и закрасим ее, чтобы она выглядела как кнопка.
Давайте сделаем его функциональным
Предоставленный здесь скрипт следует скопировать в новый модуль. Не забудьте сохранить книгу как файл книги с поддержкой макросов. Подпрограмма «Найти это» должна быть прикреплена к кнопке, которую мы только что создали.
Давайте проверим это
Добавьте адрес и другую информацию в соответствующие столбцы. Нажмите кнопку, чтобы запустить макрос, который отобразит координаты широты и долготы для всех адресов, указанных на листе. Макрос начнет работу со строки 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