Excel расчет расстояний между городами

Здравствуйте!
Пытаюсь постичь парсинг сайтов посредством VBA с выводом данных в Excel.
Очень нужная фича от

Андрей_26

, но я так же как и ТС не смог разобраться: почему у меня код не работает и как это лечить! И есть простое человеческое желание не пользоваться [потенциально] платными ресурсами гугла, яндекса и прочих. Соответственно ресурс

https://issa.ru/distance/

рулит пока — не реклама, тем более что есть негативные о ресурсе отзывы — issa не всегда срабатывает с первого раза.
То что понял(?) и вопросы написал подробно в комментариях по каждой строке кода, чтобы и идущим за мной была ясность:

Код
Sub Rasstoyanie()
Application.ScreenUpdating = False 'отключаем обновление экрана
Dim IE As Object, t$ 'объявляем переменные VBA
Set IE = CreateObject("InternetExplorer.Application") 'запуск мелкософтского браузера
IE.Visible = 1 '1 (или True) - отображаем браузер; 0 (или False)- не отображаем браузер _
'- MS IE работает инкогнито!
S = "https://issa.ru/distance/" 'адрес веб-страницы
IE.Navigate (S) 'браузер обращается к указанной веб-странице

Do While IE.Busy Or (IE.readyState <> 4): DoEvents: Loop 'не вникал, но предполагаю это _
'ожидание открытия веб-страницы

IE.Document.getelementbyid("gui-input-source").Value = Range("A2").Value 'gui-input-source _
'- значение переменной "начало пути" для веб-страницы берем из A2 Excel'я
IE.Document.getelementbyid("gui-input-target").Value = Range("B2").Value 'gui-input-target _
'- значение переменной "конец пути" для веб-страницы берем из B2 Excel'я
IE.Document.getelementbyid("gui-calculate").Click 'эмулируем нажатие на веб-странице кнопки _
'"Рассчитать[расстояние]"

Application.Wait (Now() + TimeValue("00:00:08")) 'приложение Excel ожидает 8 секунд для _
'обработки данных, построения маршрута и расчетов на веб-странице

t = IE.Document.body.innerHtml 'собственно весь код веб-страницы - ???
    
Dim REGEXP As Object 'объявляем новый объект
Set REGEXP = CreateObject("VBScript.RegExp") 'Создание объекта регулярных выражений - это и _
'нижеследующее читал на http://script-coding.com/WSH/RegExp.html
    REGEXP.IgnoreCase = True
    REGEXP.Global = False
    REGEXP.MultiLine = True
    REGEXP.Pattern = "d[^s]* <span>км" '<=== А ВОТ ТУТ ВООБЩЕ НЕ ПОНЯЛ!!! .Pattern - строка, _
    'используемая как шаблон. НО! В коде элементов веб-страницы не нашел такой конструкции! _
    'Что такое "d[^s]*"? Либо не понял конструкцию, либо на сайте были изменения с момента _
    'опубликования поста
    If REGEXP.test(t) Then
    Range("C2").Value = Replace(REGEXP.Execute(t)(0), "d[^s]* <span>км", "") ' - ???
    End If
IE.Quit 'закрываем браузер
Application.ScreenUpdating = True 'включаем обновление экрана
MsgBox "Готово!"
End Sub

Убрал цикл по строкам в Excel’е — поиск расстояния между адресами происходит по одной строке: старт — финиш; интересует только расстояние между адресами, не время в пути и расход топлива.
Собственно вопрос: либо в коде элементов веб-страницы сейчас нет конструкции «d[^s]*<span>км» (см.скрин), либо вообще не понял конструкцию.
ps WIN 10 PRO x64, Excel 2010 x32, VBA 7.0

You might think «as the crow flies» distance is nothing more than a simple hypotenuse calculation back from geometry class. Unfortunately, not. You should work with either decimal degrees or degree-minute-second (DMS) notation due to the curvy structure of Earth. This means a lot of formulas to deal with.

Also, you need coordinates (latitude/longitude) of each city you want to put in a calculation.

Thankfully, we have workarounds for both problems. In this article, we are going to show how to calculate as-the-crow-flies distance between two cities in Excel with help of LAMBDA function and data types.

Download Workbook

The formula of calculating distance by longitude and latitude

In our example, we are using the great-circle distance method which uses the shortest path, also known as, as the crow flies, between two points corresponding to an arc linking two points on a sphere. The method uses Spherical law of cosines a theorem relating the sides and angles of spherical triangles.

where

  • φ: Latitude (radian)
  • λ: Longitude (radian)
  • R: Radius of the earth

The coordinates are represented in two forms:

  • As a string including degree, minute and second
  • As a numerical value of decimal degrees

Converting degrees, minutes and seconds to decimal degrees:

Decimal Degrees = Degrees + (Minutes + Seconds / 60) / 60

Converting decimal degrees to radians:

Radians = Decimal Degrees * PI / 180

Because deg-min-sec notation will make things more confusing, we will use decimal degrees going forward. This is the Excel formula for decimal degrees:

ACOS(
   SIN(Place1_Lat * PI() / 180) *
   SIN(Place2_Lat * PI() / 180) +
   COS(Place1_Lat * PI() / 180) *
   COS(Place2_Lat * PI() / 180) *
   COS(Place2_Lon * PI() / 180 - Place1_Lon * PI() / 180)
) * EarthRadius

Obviously, no one wants to deal with this kind of formula more than one time. Instead, you can use the LAMBDA function to define this formula once in a named range and use the named range like a UDF (user-defined function). Let’s see what the LAMBDA function is and how you can use it.

LAMBDA Function

The LAMBDA function is a game changer feature that allows you to create your own functions without any VBA, macro, or JavaScript knowledge. Since its unique nature, the function has a unique use case.

  • A LAMBDA formula should be written in a named range. That named range’s name will be your custom function’s name.
  • You need to type parameter names before the function itself. Such as, a and b are the parameters and the latter operation is the function itself: =LAMBDA(a, b, a-b)
  • LAMBDA functions can be called recursively.

LAMBDA([parameter1, parameter2, …,] calculation)

For detailed information, please visit the following page: Excel LAMBDA Function

The LAMBDA function requires a Microsoft 365 subscription.

Calculating distance by longitude and latitude with LAMBDA Function

Let’s create our custom function as described above. The distance formula needs 4 arguments, if we use a static value for the radius of earth, e.g., 6,371 km.

=LAMBDA(Place1_Lat, Place1_Lon, Place2_Lat, Place2_Lon,
    ACOS(
        SIN(Place1_Lat * PI() / 180) * SIN(Place2_Lat * PI() / 180) +
            COS(Place1_Lat * PI() / 180) * COS(Place2_Lat * PI() / 180) *
                COS(Place2_Lon * PI() / 180 - Place1_Lon * PI() / 180)
    ) * 6371
)

Once created, you can re-use your custom function anywhere in this workbook. Excel even displays IntelliSense box for this function.

Tip: You can use Excel’s RADIANS function instead of multiplying by PI() / 180.

=LAMBDA(Place1_Lat,Place1_Lon,Place2_Lat,Place2_Lon,ACOS(SIN(RADIANS(Place1_Lat))*SIN(RADIANS(Place2_Lat))+COS(RADIANS(Place1_Lat))*COS(RADIANS(Place2_Lat))*COS(RADIANS(Place2_Lon)-RADIANS(Place1_Lon)))*6371)

Data Types

Let us introduce you to an Excel feature called «Data Types». The Data Types feature allows pulling data dynamically from online sources. Geographical data like countries and cities are two of them. This feature will relieve you from gathering coordinate data beforehand.

Note: Data Types have been released to all Microsoft 365 subscribers on March 28, 2019. Thus, you need to be a Microsoft 365 subscriber to access this feature.

You can find the feature button under the Data tab of the Ribbon.

All you need to do is to select cells that contain a city name and click the Geography icon. You will see an icon will be added to city names.

Once added, you can see options like population, time zone, and more, including latitude and longitude by putting a dot (.) after the cell’s reference.

Since you can get lat/lon values from a single data-type cell why do you need four arguments in your custom function? You can simplify decrease your argument number to two like below:

=LAMBDA(City1, City2,
    ACOS(
        SIN(City1.Latitude * PI() / 180) *
            SIN(City2.Latitude * PI() / 180) +
            COS(City1.Latitude * PI() / 180) *
                COS(City2.Latitude * PI() / 180) *
                COS(
                    City1.Longitude * PI() / 180 -
                        City2.Longitude * PI() / 180
                )
    ) * 6371
) 

We named our formula «DistanceByCity»:

How to calculate as-the-crow-flies distance between two cities in Excel (7)


Необходимо найти кратчайший путь между 2-мя заданными городами. Построим линейную модель и с помощью надстройки Поиск решения решим задачу.

В статье

Поиск решения MS EXCEL (6.3). Задача коммивояжера (полный граф, линейная модель)

рассматривались модели, в которых  коммивояжёру требуется посетить все имеющиеся города. В этой задаче посещение всех городов не требуется.

Задача

Имеется 11 городов, координаты которых известны. Маршруты проложены только между некоторыми городами (неполный граф). Найти кратчайший путь между 2-мя заданными городами. Построить Линейную модель.

Создание модели

Так как даны координаты городов, то сначала найдем расстояния между ними (см.

файл примера

).

Расстояния рассчитаем с помощью формулы: =

КОРЕНЬ((ИНДЕКС($C$7:$D$17;ПОИСКПОЗ($A30;$A$7:$A$17;0);1)-ИНДЕКС($C$7:$D$17;ПОИСКПОЗ(B$29;$A$7:$A$17;0);1))^2 +(ИНДЕКС($C$7:$D$17;ПОИСКПОЗ($A30;$A$7:$A$17;0);2)-ИНДЕКС($C$7:$D$17;ПОИСКПОЗ(B$29;$A$7:$A$17;0);2))^2)

Теперь создадим линейную модель для решения задачи с помощью

Поиска решения

.


Совет

: Вводная статья про

Поиск решения

в MS EXCEL 2010

находится здесь

.

Обратите внимание, что не все города соединены сообщением (столбцы J:M), например нет прямого маршрута между Москвой и Парижем. Также для модели принципиально направление маршрута: Москва — Лондон, это не тоже самое, что Лондон-Москва (при необходимости список маршрутов можно расширить).


Переменные (выделено зеленым)

. В качестве переменных модели следует взять номера маршрутов между городами: если маршрут включен в кратчайший путь, то переменная =1, если нет, то =0.

Ограничения (выделено синим)

. Необходимо, чтобы из каждого города, в котором побывал путешественник, был входящий и выходящий маршрут. Так как входящий маршрут обозначается 1, а исходящий -1, то их сумма, равная 0, будет означать, что в город вошли и вышли (включен в кратчайший путь). Исключение составляют город – начальная точка путешествия (сумма =-1) и город – конечная точка (сумма =1). Изменяя ограничение в синем столбце, можно задавать начальные и конечные пункты путешествия.

Целевая функция (выделено красным)

.

Длина маршрута должна быть минимальной.


Примечание

: для удобства настройки

Поиска решения

используются

именованные диапазоны

.

Выберите Линейный метод поиска решения, т.к. созданная модель является линейной.


Найденное

Решение


Поиск решения

гарантировано найдет самый короткий маршрут, т.к. модель линейная.

Изменив начальный и конечный пункт путешествия, и перезапустив

Поиск решения

, получим другой маршрут.

Будьте внимательны, не все пары конечных и начальных пунктов допустимы. Например, задав путешествие из Москвы в Копенгаген,

Поиск решения

не найдет маршрут, т.к. для этого потребуется «двигаться назад», а в маршрутах между городами обратные пути не прописаны (маршруты, конечно, можно добавить в столбцы J:M, но не забудьте изменить и другие формулы).

Given a list of geographic coordinate pairs, you can implement the Haversine formula directly in Excel.


The simplest way to use this (or a more accurate, but I think it’s not your case) formula consists into press Alt+F11 to open the VBA Editor, click Insert --> Module and then (copy and) paste e.g. the code kindly suggested by blah238.

Public Function getDistance(latitude1, longitude1, latitude2, longitude2)  
earth_radius = 6371  
Pi = 3.14159265  
deg2rad = Pi / 180  

dLat = deg2rad * (latitude2 - latitude1)  
dLon = deg2rad * (longitude2 - longitude1)  

a = Sin(dLat / 2) * Sin(dLat / 2) + Cos(deg2rad * latitude1) * Cos(deg2rad * latitude2) * Sin(dLon / 2) * Sin(dLon / 2)  
c = 2 * WorksheetFunction.Asin(Sqr(a))  

d = earth_radius * c  

getDistance = d  

End Function

There will be a new custom getDistance function (unit = kilometer) available in your spreadsheet which accepts four parameters, i.e. the two pairs of coordinates, as follow:

getDistance(latitude1, longitude1, latitude2, longitude2)

where latitude1, longitude1, latitude2, longitude2 should be replaced by their relative cell references.

enter image description here

Понравилась статья? Поделить с друзьями:
  • Excel расширенный фильтр максимальное значение
  • Excel расчет процессоры что это
  • Excel расширенный фильтр исходный диапазон
  • Excel расчет процессоры тормозит
  • Excel расширенный фильтр если