Коллеги, добрый день. Я уверен, что макрос о котором я попрошу нужен многочисленной аудитории, прошу помочь в этом вопросе. Сам вопрос в следующем - необходимо рассчитать расстояние между двумя адресами(как между городами так и в пределах одного города), есть портал: https://issa.ru/distance/ в нем быстро и легко рассчитывается расстояние. Как сделать так, чтобы данные с этого сайта просто переносились в excel(парсинг)?
Ничего не работает. Может я что не так делаю. Он делает расчет сразу на все строчки? Просто я думал что расчет делается напротив той строчки где есть необходимость
Вариант через API Google карт в Power Query, полученные числа не совпадают с теми, что возвращает сайт Всесто GOOGLE_API_KEY нужно вставить ключ Google API (если своего нет, то ,если постараться, его можно найти на сайте из первого поста)
Код
let
Source = Excel.CurrentWorkbook(){[Name="Таблица1"]}[Content][[Место отбытия],[Место прибытия]],
GapiKey = "GOOGLE_API_KEY",
PlaceID=(address)=>try Xml.Tables(Web.Contents("https://maps.google.com/maps/api/geocode/xml?address="&address&"&key="&GapiKey)){0}[result]{0}[place_id] otherwise null,
DistMatrix=(Origin,Destination)=>if Origin=null or Destination=null then null else Xml.Tables(Web.Contents("https://maps.googleapis.com/maps/api/distancematrix/xml?origins=place_id:"&Origin&"&destinations=place_id:"&Destination&"&key="&GapiKey)){0}[row]{0}[element],
AddColumn = Table.AddColumn(Source, "Пользовательская", each Function.InvokeAfter(()=>DistMatrix(PlaceID([Место отбытия]),PlaceID([Место прибытия])),#duration(0,0,0,1.5))),
Expand = Table.ExpandTableColumn(Table.ExpandTableColumn(Table.ExpandTableColumn(AddColumn, "Пользовательская", {"distance","duration"}), "distance", {"value"}, {"Расстояние, км."}),"duration", {"value"}, {"Время"})
in
Table.TransformColumns(Expand,{{"Расстояние, км.", each try Number.From(_)/1000 otherwise null, type number},{"Время", each try Time.From(Number.From(#duration(0,0,0,Number.From(_)))) otherwise null, type time}})
Здравствуйте! Пытаюсь постичь парсинг сайтов посредством 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
Добрый вечер! Уважаемые участники, прошу помощи, можно допилить макрос с учётом того, что сайт чуть изменил код веб-страницы? Задача чрезвычайно актуальна! Заранее благодарен!