Расчет расстояния между координатами в excel
Доброго времени суток!
В просторах интернета готовых решений найти не удалось, но тема и сама затея может быть кому-нибудь будет интересной и полезной.
Цель определить расстояние между городами, местами, конкретными адресами и тд
Полазив по гуглу, и экспериментируя руками, получилось найти структуру ответа на запрос по расстоянию на карте между пунктами в виде xml
Атрибут distance дает расстояние в метрах.
Распарсить xml я не могу т.к. этот отрезок vba мне дается тяжело
Sub DistanceXML()
Dim urladr, a, b
a = InputBox("Пункт А", "А", "")
b = InputBox("Пункт Б", "Б", "")
a = Replace(a, " ", "+")
a = Replace(a, ",", "+")
b = Replace(b, " ", "+")
b = Replace(b, ",", "+")
urladr = "https://maps.googleapis.com/maps/api/distancematrix/xml?origins=" & a & "|Seattle&destinations Расстояние " & distance & " метров :)"
End Sub
Доброго времени суток!
В просторах интернета готовых решений найти не удалось, но тема и сама затея может быть кому-нибудь будет интересной и полезной.
Цель определить расстояние между городами, местами, конкретными адресами и тд
Полазив по гуглу, и экспериментируя руками, получилось найти структуру ответа на запрос по расстоянию на карте между пунктами в виде xml
Атрибут distance дает расстояние в метрах.
Распарсить xml я не могу т.к. этот отрезок vba мне дается тяжело
Sub DistanceXML()
Dim urladr, a, b
a = InputBox("Пункт А", "А", "")
b = InputBox("Пункт Б", "Б", "")
a = Replace(a, " ", "+")
a = Replace(a, ",", "+")
b = Replace(b, " ", "+")
b = Replace(b, ",", "+")
urladr = "https://maps.googleapis.com/maps/api/distancematrix/xml?origins=" & a & "|Seattle&destinations Расстояние " & distance & " метров :)"
End Sub
Цель определить расстояние между городами, местами, конкретными адресами и тд
Полазив по гуглу, и экспериментируя руками, получилось найти структуру ответа на запрос по расстоянию на карте между пунктами в виде xml
Атрибут distance дает расстояние в метрах.
Распарсить xml я не могу т.к. этот отрезок vba мне дается тяжело
Sub DistanceXML()
Dim urladr, a, b
a = InputBox("Пункт А", "А", "")
b = InputBox("Пункт Б", "Б", "")
a = Replace(a, " ", "+")
a = Replace(a, ",", "+")
b = Replace(b, " ", "+")
b = Replace(b, ",", "+")
urladr = "https://maps.googleapis.com/maps/api/distancematrix/xml?origins=" & a & "|Seattle&destinations Расстояние " & distance & " метров :)"
End Sub
Плохо искали
Вот тут есть и тут
По моему что-то даже тут на форуме было. Автор - SLAVICK
Дата добавления - 02.02.2016 в 01:26
Public Sub GetDistance()
Dim a, b, GetDistance As String
a = InputBox("Пункт А", "А", "")
b = InputBox("Пункт Б", "Б", "")
Dim firstVal As String, secondVal As String, lastVal As String
firstVal = "http://maps.googleapis.com/maps/api/distancematrix/json?origins &destinations &mode=car&language=pl&sensor=false"
Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
URL = firstVal & Replace(a, " ", "+") & secondVal & Replace(b, " ", "+") & lastVal
objHTTP.Open "GET", URL, False
objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
objHTTP.send ("")
If InStr(objHTTP.responseText, """distance"" : <") = 0 Then GoTo ErrorHandl
Set regex = CreateObject("VBScript.RegExp"): regex.Pattern = """value"".*?(1+)": regex.Global = False
Set matches = regex.Execute(objHTTP.responseText)
tmpVal = Replace(matches(0).SubMatches(0), ".", Application.International(xlListSeparator))
GetDistance = CDbl(tmpVal)
MsgBox GetDistance
Exit Sub
ErrorHandl:
GetDistance = -1
End Sub
Public Sub GetDistance()
Dim a, b, GetDistance As String
a = InputBox("Пункт А", "А", "")
b = InputBox("Пункт Б", "Б", "")
Dim firstVal As String, secondVal As String, lastVal As String
firstVal = "http://maps.googleapis.com/maps/api/distancematrix/json?origins &destinations &mode=car&language=pl&sensor=false"
Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
URL = firstVal & Replace(a, " ", "+") & secondVal & Replace(b, " ", "+") & lastVal
objHTTP.Open "GET", URL, False
objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
objHTTP.send ("")
If InStr(objHTTP.responseText, """distance"" : <") = 0 Then GoTo ErrorHandl
Set regex = CreateObject("VBScript.RegExp"): regex.Pattern = """value"".*?(2+)": regex.Global = False
Set matches = regex.Execute(objHTTP.responseText)
tmpVal = Replace(matches(0).SubMatches(0), ".", Application.International(xlListSeparator))
GetDistance = CDbl(tmpVal)
MsgBox GetDistance
Exit Sub
ErrorHandl:
GetDistance = -1
End Sub
Public Sub GetDistance()
Dim a, b, GetDistance As String
a = InputBox("Пункт А", "А", "")
b = InputBox("Пункт Б", "Б", "")
Dim firstVal As String, secondVal As String, lastVal As String
firstVal = "http://maps.googleapis.com/maps/api/distancematrix/json?origins &destinations &mode=car&language=pl&sensor=false"
Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
URL = firstVal & Replace(a, " ", "+") & secondVal & Replace(b, " ", "+") & lastVal
objHTTP.Open "GET", URL, False
objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
objHTTP.send ("")
If InStr(objHTTP.responseText, """distance"" : <") = 0 Then GoTo ErrorHandl
Set regex = CreateObject("VBScript.RegExp"): regex.Pattern = """value"".*?(9+)": regex.Global = False
Set matches = regex.Execute(objHTTP.responseText)
tmpVal = Replace(matches(0).SubMatches(0), ".", Application.International(xlListSeparator))
GetDistance = CDbl(tmpVal)
MsgBox GetDistance
Exit Sub
ErrorHandl:
GetDistance = -1
End Sub
Set xmlDoc = CreateObject("Microsoft.XMLDOM")
xmlDoc.Load urladr
Do While xmlDoc.readyState <> 4
DoEvents
Loop
distance = xmlDoc.SelectSingleNode("//distance/value").Text
MsgBox "Расстояние " & distance & " метров :)"
Set xmlDoc = CreateObject("Microsoft.XMLDOM")
xmlDoc.Load urladr
Do While xmlDoc.readyState <> 4
DoEvents
Loop
distance = xmlDoc.SelectSingleNode("//distance/value").Text
MsgBox "Расстояние " & distance & " метров :)"
Set xmlDoc = CreateObject("Microsoft.XMLDOM")
xmlDoc.Load urladr
Do While xmlDoc.readyState <> 4
DoEvents
Loop
distance = xmlDoc.SelectSingleNode("//distance/value").Text
MsgBox "Расстояние " & distance & " метров :)"
Действительно:D
Спасибо огромное!!
Doober, просто превосходно.
Благодарю за помощь. Автор - Валерьянка
Дата добавления - 02.02.2016 в 02:14
Sub LatLong()
Dim a, lat, lng, urladr As String
a = InputBox("Место назначения (Город, адрес)", "Пункт", "")
urladr = "http://maps.google.com/maps/api/geocode/xml?address=" & Replace(a, " ", "+") & "&sensor=false"
Set xmlDoc = CreateObject("Microsoft.XMLDOM")
xmlDoc.Load urladr
Do While xmlDoc.readyState <> 4
DoEvents
Loop
lat = xmlDoc.SelectSingleNode("//location/lat").Text
lng = xmlDoc.SelectSingleNode("//location/lng").Text
MsgBox lat & "," & lng
End Sub
Sub LatLong()
Dim a, lat, lng, urladr As String
a = InputBox("Место назначения (Город, адрес)", "Пункт", "")
urladr = "http://maps.google.com/maps/api/geocode/xml?address=" & Replace(a, " ", "+") & "&sensor=false"
Set xmlDoc = CreateObject("Microsoft.XMLDOM")
xmlDoc.Load urladr
Do While xmlDoc.readyState <> 4
DoEvents
Loop
lat = xmlDoc.SelectSingleNode("//location/lat").Text
lng = xmlDoc.SelectSingleNode("//location/lng").Text
MsgBox lat & "," & lng
End Sub
[/vba]
[moder]Какое отношение этот вопрос имеет к расчету расстояния?
Создайте новую тему.[/moder] Валерьянка
Sub LatLong()
Dim a, lat, lng, urladr As String
a = InputBox("Место назначения (Город, адрес)", "Пункт", "")
urladr = "http://maps.google.com/maps/api/geocode/xml?address=" & Replace(a, " ", "+") & "&sensor=false"
Set xmlDoc = CreateObject("Microsoft.XMLDOM")
xmlDoc.Load urladr
Do While xmlDoc.readyState <> 4
DoEvents
Loop
lat = xmlDoc.SelectSingleNode("//location/lat").Text
lng = xmlDoc.SelectSingleNode("//location/lng").Text
MsgBox lat & "," & lng
End Sub
[/vba]
[moder]Какое отношение этот вопрос имеет к расчету расстояния?
Создайте новую тему.[/moder] Автор - Валерьянка
Дата добавления - 04.02.2016 в 14:44
Googlе рассчитывает расстояние исходя из маршрута и средства передвижения, загруженности дороги и т.п.
потому расстояние может постоянно изменятся.
Наиболее точное геодезическое расстояние, для оценки отдаленности, можно получить от пункта А до Б по прямой
Вот что у меня получилось собрать :)
Sub Расстояние()
Const pi = 3.14159265358979 ' определяем константу pi
lat1 = 56.7529556 ' Широта А
lng1 = 37.1969234 ' Долгота А
lat2 = 56.7523821 ' Широта Б
lng2 = 37.1976746 ' Долгота Б
' переводим градусы в радианы
GradToRadLat1 = lat1 * pi / 180 ' Радианы Широты А
GradToRadLng1 = lng1 * pi / 180 ' Радианы Долготы А
GradToRadLat2 = lat2 * pi / 180 ' Радианы Широты Б
GradToRadLng2 = lng2 * pi / 180 ' Радианы Долготы Б
a = 6378137 ' экваториальный радиус земли (метров)
f = 1 / 298.257223563 ' сжатие
b = a * (1 - f) ' полярный радиус
GSinLat = (Sin((GradToRadLat1 - GradToRadLat2) / 2) ^ 2) 'Гаверсинус широты
GSinLng = (Sin((GradToRadLng1 - GradToRadLng2) / 2) ^ 2) 'Гаверсинус долготы
CosLat = Cos(GradToRadLat1) * Cos(GradToRadLat2) 'Произведение косинусов широт
'вычисление арксинуса угла (Sqr(GSinLat + GSinLng * CosLat)
x = Sqr(GSinLat + GSinLng * CosLat)
Arcsin = Atn(x / Sqr(-x * x + 1))
'расчет дистанции
dist = (a + b) * Arcsin
MsgBox dist
End Sub
Как получить координаты смотрите здесь
Googlе рассчитывает расстояние исходя из маршрута и средства передвижения, загруженности дороги и т.п.
потому расстояние может постоянно изменятся.
Наиболее точное геодезическое расстояние, для оценки отдаленности, можно получить от пункта А до Б по прямой
Вот что у меня получилось собрать :)
Sub Расстояние()
Const pi = 3.14159265358979 ' определяем константу pi
lat1 = 56.7529556 ' Широта А
lng1 = 37.1969234 ' Долгота А
lat2 = 56.7523821 ' Широта Б
lng2 = 37.1976746 ' Долгота Б
' переводим градусы в радианы
GradToRadLat1 = lat1 * pi / 180 ' Радианы Широты А
GradToRadLng1 = lng1 * pi / 180 ' Радианы Долготы А
GradToRadLat2 = lat2 * pi / 180 ' Радианы Широты Б
GradToRadLng2 = lng2 * pi / 180 ' Радианы Долготы Б
a = 6378137 ' экваториальный радиус земли (метров)
f = 1 / 298.257223563 ' сжатие
b = a * (1 - f) ' полярный радиус
GSinLat = (Sin((GradToRadLat1 - GradToRadLat2) / 2) ^ 2) 'Гаверсинус широты
GSinLng = (Sin((GradToRadLng1 - GradToRadLng2) / 2) ^ 2) 'Гаверсинус долготы
CosLat = Cos(GradToRadLat1) * Cos(GradToRadLat2) 'Произведение косинусов широт
'вычисление арксинуса угла (Sqr(GSinLat + GSinLng * CosLat)
x = Sqr(GSinLat + GSinLng * CosLat)
Arcsin = Atn(x / Sqr(-x * x + 1))
'расчет дистанции
dist = (a + b) * Arcsin
MsgBox dist
End Sub
Как получить координаты смотрите здесь Валерьянка
Вот что у меня получилось собрать :)
Sub Расстояние()
Const pi = 3.14159265358979 ' определяем константу pi
lat1 = 56.7529556 ' Широта А
lng1 = 37.1969234 ' Долгота А
lat2 = 56.7523821 ' Широта Б
lng2 = 37.1976746 ' Долгота Б
' переводим градусы в радианы
GradToRadLat1 = lat1 * pi / 180 ' Радианы Широты А
GradToRadLng1 = lng1 * pi / 180 ' Радианы Долготы А
GradToRadLat2 = lat2 * pi / 180 ' Радианы Широты Б
GradToRadLng2 = lng2 * pi / 180 ' Радианы Долготы Б
a = 6378137 ' экваториальный радиус земли (метров)
f = 1 / 298.257223563 ' сжатие
b = a * (1 - f) ' полярный радиус
GSinLat = (Sin((GradToRadLat1 - GradToRadLat2) / 2) ^ 2) 'Гаверсинус широты
GSinLng = (Sin((GradToRadLng1 - GradToRadLng2) / 2) ^ 2) 'Гаверсинус долготы
CosLat = Cos(GradToRadLat1) * Cos(GradToRadLat2) 'Произведение косинусов широт
'вычисление арксинуса угла (Sqr(GSinLat + GSinLng * CosLat)
x = Sqr(GSinLat + GSinLng * CosLat)
Arcsin = Atn(x / Sqr(-x * x + 1))
'расчет дистанции
dist = (a + b) * Arcsin
MsgBox dist
End Sub
Как получить координаты смотрите здесь Автор - Валерьянка
Дата добавления - 12.02.2016 в 03:17
Всем привет и хорошего настроения!
Предлагаю Вашему вниманию мою реализацию в Excel формулы гаверсинусов.
Первоисточник - вики, можно найти ЗДЕСЬ. С указанным мной радиусом земли погрешность получается до 1%, можно улучшить если поиграть значением. Не рекомендуется для проверки расстояний между объектами, расположенными диаметрально противоположно друг от друга через центр планеты.
Во вложении есть развёрнутый пошаговый вариант расчётов. Если вкратце, то суть такая:
Всем привет и хорошего настроения!
Предлагаю Вашему вниманию мою реализацию в Excel формулы гаверсинусов.
Первоисточник - вики, можно найти ЗДЕСЬ. С указанным мной радиусом земли погрешность получается до 1%, можно улучшить если поиграть значением. Не рекомендуется для проверки расстояний между объектами, расположенными диаметрально противоположно друг от друга через центр планеты.
Во вложении есть развёрнутый пошаговый вариант расчётов. Если вкратце, то суть такая:
Предлагаю Вашему вниманию мою реализацию в Excel формулы гаверсинусов.
Первоисточник - вики, можно найти ЗДЕСЬ. С указанным мной радиусом земли погрешность получается до 1%, можно улучшить если поиграть значением. Не рекомендуется для проверки расстояний между объектами, расположенными диаметрально противоположно друг от друга через центр планеты.
Во вложении есть развёрнутый пошаговый вариант расчётов. Если вкратце, то суть такая:
Где А1:А4 - координаты точек, А11 - радиус Земли в километрах. Автор - Rioran
Дата добавления - 16.10.2015 в 15:24
Иногда все проще чем кажется с первого взгляда.
SLAVICK, спасибо за информацию. Да, формулы принципиально одинаковы и используют гаверсинусы. Вижу, что вроде AlexM первее всех это сделал - 09.07.2014 здесь. Только в той теме такой термин отсутствует, поэтому когда я гуглил форум - не нашёл, пришлось задублить =)
SLAVICK, спасибо за информацию. Да, формулы принципиально одинаковы и используют гаверсинусы. Вижу, что вроде AlexM первее всех это сделал - 09.07.2014 здесь. Только в той теме такой термин отсутствует, поэтому когда я гуглил форум - не нашёл, пришлось задублить =) Rioran
Предположим, что перед нами стоит классическая задача транспортной логистики: визуализировать движение некоего объекта по заданному маршруту из нескольких промежуточных точек. Для конкретики, давайте возьмем скорый фирменный поезд "Жигули", движущийся по маршруту Москва - Самара по следующему графику (взято из Яндекс.Расписаний):
Для решения задачи нам потребуется Excel 2013-2016 с установленной надстройкой Power Map. В Excel 2016 она установлена по умолчанию, для Excel 2013 можно скачать ее бесплатную превью-версию.
Этап 1. Находим координаты
Для однозначной привязки к промежуточным пунктам маршрута лучше использовать не названия населенных пунктов (они могут повторяться либо отсутствовать в принципе в нужном месте), а нормальные географические координаты. Достаточно щелкнуть по нужному месту в Яндекс-картах или Google Maps и вы увидите широту и долготу этой точки:
Добавим найденные координаты к нашей исходной таблице расписания движения поезда:
Этап 2. Дробим перегоны
Для плавного отображения движения поезда на карте нам необходимо разделить каждый перегон на несколько участков (чем их больше, тем плавнее будет анимация). Таким образом, перед нами встает задача получить примерные координаты и время для каждой промежуточной точки. Решить проблему можно формулой либо макросом.
Например, если хотим разбить каждый перегон на шесть интервалов (т.е. пять точек), то можно реализовать все одной формулой:
Но вставлять промежуточные строки, вводить и копировать формулу на все зеленые ячейки для каждого перегона придется вручную.
Другой вариант - макрос, что гораздо удобнее при большом количестве перегонов и промежуточных точек маршрута. Откройте редактор Visual Basic на вкладке Разработчик (Developer) или нажмите сочетание клавиш Alt + F11 . Вставьте в вашу книгу новый пустой модуль через меню Insert - Module и скопируйте туда этот код:
Как легко сообразить, константа MINS_IN_ONE_STEP задает количество минут в каждом шаге - можете менять ее значение по своему усмотрению. Теперь если выделить таблицу с данными или установить в нее активную ячейку, а потом запустить наш макрос сочетанием клавиш Alt + F8 или кнопкой Макросы на вкладке Разработчик (Developer - Macros) , то наша таблица будет преобразована в следующий вид:
Как видите, каждый перегон теперь делится на несколько интервалов - по 1 минуте каждый.
Этап 3. Переходим к карте
Осталось совсем чуть-чуть. Выделите полученную таблицу и на вкладке Вставка нажмите кнопку 3D-карта (Insert - 3D-map) :
Не перепутайте ее с кнопкой Карты (которая с глобусом) или Карты Bing (желтого цвета). После нажатия должно открыться окно надстройки Power Map.
В правой части окна на панели добавьте в группе Расположение (Location) поля широты и долготы и выберите напротив каждого название соответствующего столбца из нашей таблицы. Если все сделаете правильно, то на карте тут же должен отобразиться наш маршрут:
Теперь осталось выбрать в выпадающем списке Время (Time) столбец со значениями даты-времени из нашей таблицы и можно запускать анимацию с помощью кнопки воспроизведения в нижней части окна:
Дополнительно можно поиграться настройками слоя - кнопка Параметры слоя (Layer Options) в правом нижнем углу - и установить цвет, размер, прозрачность и т.д. отображаемых точек.
Если нажать на неприметную иконку с часами рядом с выпадающим списком Время, то можно поменять режим отображения и рисовать не маршрут, а сам поезд.
При щелчке левой кнопкой мыши по любой интересующей точке маршрута мы увидим ее подробные данные - координаты и время прохождения:
Этап 4. Несколько поездов сразу
Не секрет, что на самом деле по маршруту Москва-Самара курсируют два состава - в противофазе: когда один стартует из Москвы, другой примерно в то же время начинает движение ему навстречу из Самары. Утром один из них приходит в Самару, а другой, соответственно, в Москву и вечером процесс запускается заново. Расписание второго примерно отзеркаливает первый:
Что сделать, чтобы отобразить их на карте оба сразу?
Если по маршруту одновременно движется больше одного объекта, то данные по ним можно обработать аналогичным образом (Этапы 1 и 2) и просто добавить в продолжение нашей маршутной таблицы. А чтобы отличать поезда друг от друга, добавить еще один столбец с названием объекта:
Теперь, если построить по такой таблице еще одну визуализацию, мы будем видеть движение двух составов одновременно:
Ссылки по теме
Добрый день
Николай,-очень кстати данная тема, работа связана с транспортом и маршрутами,давно ждал что то подобное.Огромное Вам спасибо
Просто прекрасная и нужная инструкция. Николай, коллеги, а подскажите, пожалуйста, какой модуль к MS Office должен быть подключен для того, чтобы было доступно:
Вставка ---> нажмите кнопку 3D-карта (Insert - 3D-map) :
"Для решения задачи нам потребуется Excel 2013-2016 с установленной надстройкой Power Map. В Excel 2016 она установлена по умолчанию, для Excel 2013 можно скачать ее бесплатную превью-версию ."
Спасибо за урок! Не сочтите за докапывание, но в конце 2 этапа "Как видите, каждый перегон теперь делится на несколько интервалов - по 1 секунде каждый." - по минуте же - не?
Э.. да, конечно! Спасибо!
Очень крутая тема .
Предлагаю развить на предмет расчета расстояния.
Подскажите пожалуйста как это возможно реализовать с помощью google map например?
У меня есть вот такой макрос, который рассчитывает расстояние, маршрут и время в пути. Мне необходима только та часть которая отвечает за измерение расстояния. Самостоятельно разобрать не хватает знаний. Буду признателен за помощь.
Option Explicit
Public ActivationMark As Boolean
Public WasRequestGoogle As Boolean
Public MyDistance As Variant
Public MyDuration As Variant
'Задаем границы допустимых координат
Public Const Lat_min = -180, Lat_max = 180
Public Const Lon_min = -180, Lon_max = 180
'Скрываем заставку
Private Sub KillTheForm()
Unload Excelminsk
End Sub
Sub GetDistanceDurationGoogle(Address1 As String, Address2 As String)
Dim XMLDoc As Object
Dim Coord1NodeList As Object, Coord2NodeList As Object
Dim DistanceNodeList As Object, DurationNodeList As Object
Dim MyRequest As String
Dim Lat1 As String, Lon1 As String, Lat2 As String, Lon2 As String
On Error Resume Next
'Обнуляем переменные
MyDistance = ""
MyDuration = ""
'Ставим задержку между запросами
If (Address1 = Range("A3";) And Address2 = Range("B3";)) Then
Else
Application.Wait (Now + TimeValue("0:00:01";))
End If
'Кодируем адрес
Address1 = RussianStringToURLEncode_New(Address1)
Address2 = RussianStringToURLEncode_New(Address2)
MyRequest = "https://maps.googleapis.com/maps/api/directions/xml?origin=" & Address1 & "&destination=" & Address2 & "&mode=driving&language=ru"
'Debug.Print MyRequest
'Загружаем XML-документ
Set XMLDoc = CreateObject("Msxml2.DOMDocument";)
XMLDoc.async = False
If Not XMLDoc.Load(MyRequest) = True Then
MyDistance = "!ДАННЫЕ НЕ ЗАГРУЖЕНЫ"
MyDuration = "!ДАННЫЕ НЕ ЗАГРУЖЕНЫ"
Exit Sub
End If
'Считываем статус ответа
Select Case XMLDoc.SelectNodes("*/status";).Item(0).text
Case "OK"
Case "NOT_FOUND"
'Не нашел адрес точки
MyDistance = "!НЕ НАШЕЛ АДРЕС"
MyDuration = "!НЕ НАШЕЛ АДРЕС"
Exit Sub
Case "ZERO_RESULTS"
'Не может проложить маршрут
MyDistance = "!НЕТ ДОРОГИ"
MyDuration = "!НЕТ ДОРОГИ"
Exit Sub
Case "OVER_QUERY_LIMIT"
If WasRequestGoogle = False Then
Application.Wait (Now + TimeValue("0:00:02";))
WasRequestGoogle = True
Call GetDistanceDurationGoogle(Address1, Address2)
Exit Sub
Else
MyDistance = "!ПРЕВЫШЕНИЕ ЛИМИТА"
MyDuration = "!ПРЕВЫШЕНИЕ ЛИМИТА"
Exit Sub
End If
Case "REQUEST_DENIED"
MyDistance = "!ЗАПРОС ОТКЛОНЕН"
MyDuration = "!ЗАПРОС ОТКЛОНЕН"
Exit Sub
Case "INVALID_REQUEST"
MyDistance = "!НЕВЕРНЫЙ ЗАПРОС"
MyDuration = "!НЕВЕРНЫЙ ЗАПРОС"
Exit Sub
Case "UNKNOWN_ERROR"
MyDistance = "!НЕИЗВЕСТНАЯ ОШИБКА"
MyDuration = "!НЕИЗВЕСТНАЯ ОШИБКА"
Exit Sub
End Select
'Получаем координаты
Set Coord1NodeList = XMLDoc.SelectNodes("*//start_location";)
Lat1 = Coord1NodeList.Item(Coord1NodeList.Length - 1).FirstChild.text
Lon1 = Coord1NodeList.Item(Coord1NodeList.Length - 1).LastChild.text
Set Coord2NodeList = XMLDoc.SelectNodes("*//end_location";)
Lat2 = Coord2NodeList.Item(Coord2NodeList.Length - 1).FirstChild.text
Lon2 = Coord2NodeList.Item(Coord2NodeList.Length - 1).LastChild.text
'Debug.Print "Coord1=" & Lat1 & ", " & Lon1
'Debug.Print "Coord2=" & Lat2 & ", " & Lon2
'Проверяем ограничения для координат
If MyValue(Lat1) < Lat_min Or MyValue(Lat1) >Lat_max Or MyValue(Lon1) < Lon_min Or MyValue(Lon1) >Lon_max Or _
MyValue(Lat2) < Lat_min Or MyValue(Lat2) >Lat_max Or MyValue(Lon2) < Lon_min Or MyValue(Lon2) >Lon_max Then
MyDistance = "!ОГРАНИЧЕНИЕ ДЕМО"
MyDuration = "!ОГРАНИЧЕНИЕ ДЕМО"
Else
'Расстояние в метрах
Set DistanceNodeList = XMLDoc.SelectNodes("*//distance";)
MyDistance = Round(DistanceNodeList.Item(DistanceNodeList.Length - 1).FirstChild.text / 1000, 0)
'Debug.Print "MyDistance *//duration";)
MyDuration = CLng(DurationNodeList.Item(DurationNodeList.Length - 1).FirstChild.text) / 3600 / 24
'Debug.Print "MyDuration %" & Hex(AscW(l) \ 64 \ 64 + 224) & "%" & Hex(AscW(l) \ 64) & "%" & Hex(8 * 16 + AscW(l) Mod 64)
Case Is > 127: t = "%" & Hex(AscW(l) \ 64 + 192) & "%" & Hex(8 * 16 + AscW(l) Mod 64)
Case 32: t = "%20"
Case Else: t = l
End Select
RussianStringToURLEncode_New = RussianStringToURLEncode_New & t
Next
End Function
'Конвертируем широту и долготу из текста в число
Function MyValue(ByVal text As String) As Double
Dim MySeparator As String
'Считываем системный разделитель
MySeparator = Application.International(xlDecimalSeparator)
MyValue = (Trim(Replace(text, ".", MySeparator)) + 0)
End Function
В настоящее время я составляю фиктивную схему базы данных с двумя таблицами: Booking и Waypoint .
- Booking хранит информацию о бронировании такси.
- В путевой точке хранятся точки посадки и высадки во время поездки, а также координаты широты. Каждая последовательность - это остановка в пути.
Как мне рассчитать расстояние между разными остановками в каждой поездке (используя данные широты и долготы) в Excel?
Есть ли способ программно определить это в Excel, т.е. чтобы формулу можно было поместить в столбец mileage (таблица Booking ), найдите соответствующую последовательность (через bookingId ) для этого путешествовать по таблице Waypoint и вернуть результат?
Пример 1:
Путешествие с 2 остановками:
4,1 мили согласно Google, запись сделана в столбце mileage в таблице Booking , где id = 1
Пример 2:
Путешествие с 3 остановками:
27,7 миль согласно Google, запись сделана в столбце mileage в таблице Booking , где id = 3
4 ответа
До недавнего времени точные карты строились с помощью триангуляции, которая, по сути, является применением теоремы Пифагора. Для расстояния между любой парой координат возьмите квадратный корень из суммы квадрата разницы в координатах x и квадрата разницы в координатах y. Однако координаты x и y должны быть в одних и тех же единицах измерения (например, в милях), что требует факторизации значений широты и долготы. Это может быть сложно, потому что множитель для долготы зависит от широты (прогулка вокруг Северного полюса меньше, чем прогулка вокруг экватора), но в вашем случае фактор 52 o Север должен служить. Исходя из этого, результаты (которые можно проверить здесь) примерно на 20% отличаются от примеров. вы даете (во втором случае с идентификаторами пары 6 и 7 и добавлением этого результата к результату сопряжения идентификаторов 7 и 8).
Если вы хотите найти расстояние между двумя точками, просто используйте эту формулу, и вы получите результат в км, при необходимости просто конвертируйте в мили.
Точка A: LAT1, LONG1 Точка B: LAT2, LONG2
ACOS (COS (РАДИАНЫ (90-Lat1)) * COS (РАДИАНЫ (90-Lat2)) + SIN (РАДИАНЫ (90-Lat1)) * SIN (РАДИАНЫ (90-lat2)) * COS (РАДИАНЫ (long1-long2) )) * 6371
Поскольку вы говорите, что точность не важна, и предполагая, что расстояния небольшие (скажем, менее 1000 миль), вы можете использовать локсодромное расстояние.
Для этого вычислите разницу широты (dlat) и разницу долготы (dlon). Если была вероятность (маловероятная), что вы пересекаете меридиан 180 °, возьмите модуль 360 °, чтобы убедиться, что разница долгот составляет от -180 ° до 180 °. Также вычислите среднюю широту (alat).
Это расстояние выражается в морских милях. Примените преобразования по мере необходимости.
ОБЪЯСНЕНИЕ: здесь используется тот факт, что одна морская миля по определению всегда равна одной угловой минуте широты. Косинус соответствует тому факту, что меридианы становятся ближе друг к другу по мере приближения к полюсам. Остальное - всего лишь применение теоремы Пифагора, которая требует, чтобы соответствующая часть земного шара была плоской, что, конечно, является лишь хорошим приближением для малых расстояний.
Я пытаюсь использовать excel для расчета расстояния между двумя точками с координатами x, y и z, используя формулу distance = SQRT ((X1-X2) ^ 2 + (Y1-Y2) ^ 2 + (Z1-Z2) ^ 2 )). Формула отлично работает для отдельных вычислений. Моя проблема заключается в моей способности применить эту формулу к большой таблице, похожей на прилагаемое изображение. (Диагональ должна равняться нулю)
Пример таблицы, которая у меня есть, и таблицы, которую я хочу сделать:
Можно ли это сделать в Excel? Любое понимание будет оценено. Спасибо, Деррик
3 ответа
Хорошо, я собираюсь сделать две вещи: (1) наметить решение и (2) научить вас ловить рыбу, объясняя, как это делать в будущем.
Хорошо, поскольку некоторые показали, что ВПР - ваш друг, однако при использовании этого лучше всего иметь вашу диаграмму поиска на отдельной странице, чтобы вы могли легко расширить ее позже, однако, если вы хотите показать и то, и другое на странице результатов, у вас есть примеры этого также.
Также имейте в виду, что программы любят числа - так что всякий раз, когда вы можете заменить строки понятными числами, сделайте так, это ускорит обработку.
Итак, в моем примере я поместил вашу карту города на отдельный лист (CityChart) следующим образом
Итак, первое, что вам нужно сделать, это убедиться, что вы можете извлекать данные из вашей поисковой диаграммы ожидаемым образом. Итак, на отдельном листе мы создаем диаграмму расстояний следующим образом:
Затем в позиции 1,1 мы выполняем базовый поиск, чтобы получить X1
X1 => = ВПР ($ A2, 'CityChart'! $ A $ 2: $ D $ 6, 2)
Нажмите, и отображаемое значение должно быть: 1
Теперь вы можете скопировать эту ячейку из 1,1 и вставить ее в 2,1–6,1, и вы должны получить соответствующие результаты из своей CityChart.
Теперь скопируйте формулу без знака = в ячейку для дальнейшего использования.
Мы преодолели первое препятствие.
Теперь нам нужно получить X2
По сути, та же формула, но вместо того, чтобы брать столбец 1, мы берем строку 1 следующим образом - снова в ячейке 1,1 мы пишем
Убедитесь, что он работает, скопируйте его в ячейки 1,2–1,6, чтобы убедиться, что он возвращает соответствующие значения, затем скопируйте формулу для дальнейшего использования.
Теперь у нас есть .
Поэтому нам нужно экстраполировать это на Y и Z или столбцы 3 и 4 CityChart следующим образом:
Теперь нам нужно расширить это и перейти к вашей формуле. Мы начинаем с установки наших двух инкапсуляций (), а затем копируем / вставляем наши ссылки, добавляя знак вычитания по мере продвижения.
Почему вы делаете это систематически правильно, чтобы избежать ошибки, которая есть в вашей формуле, например - если вы присмотритесь, вы увидите, что у вас их слишком много ")"
Затем мы добавляем ^ 2 в конец
Затем все, что осталось, это вставить это в вашу функцию SQRT () вместе со знаками +
Как только у вас будет полная формула, скопируйте ее и поместите перед знаком = в ячейке 1,1 и нажмите return, вы должны получить 0
Затем скопируйте его и вставьте либо в полную строку, либо в полный столбец - затем скопируйте всю строку / столбец, выделите оставшиеся ячейки и вставьте - альт быстрое и простое расширение кода.
Просто чтобы сделать домашнее задание:
Если ваш лист выглядит так:
Затем просто используйте формулу массива
И заполняем вниз / вправо;)
ИЗМЕНИТЬ
Также будет работать (формула без массива)
Следующая формула должна работать.
Первая ВПР каждой пары использует список столбцов (предположительно, столбец A), чтобы найти числа для первого города (убедитесь, что ссылка на столбец является абсолютной с символом $ перед буквой столбца).
Вторая ВПР каждой пары использует список строк в верхней части матрицы для ссылки на координаты второго города (убедитесь, что ссылка на строку является абсолютной с символом $ перед номером строки).
Используйте часть формулы «$ A $ 2: $ D $ 6», чтобы создать абсолютную ссылку на ссылочные номера городов и столбцы информации x, y, z. (используйте $ перед номерами строк и буквами столбцов)
Третий элемент каждой ВПР относится к номеру столбца абсолютной ссылки (см. Шаг 5). В этом случае x = 2, y = 3 и z = 4.
«Ложь» в каждом операторе ВПР, вероятно, не обязательна, но мне нравится использовать ее для предотвращения ошибок. Это обеспечивает «точное совпадение» формулы ВПР.
Читайте также: