Расчет расстояния между адресами с помощью Google API в Excel (VBA) - PullRequest
0 голосов
/ 12 марта 2020

Я работаю над магистерской диссертацией и очень нуждаюсь в вашей помощи с некоторыми расчетами расстояния.

Я действительно борюсь с некоторым кодом, который я нашел в сети, чтобы вычислить расстояние между несколькими адресами (~ 10k пар). Я попробовал два разных кода с двух веб-сайтов, и они оба выдают мне ошибку.

Я уже создал свой собственный API Google и активировал биллинг (использование теста URL действительно работает для меня) и попробовал некоторые предложения от других форумы.

1. Подход Найдено по: https://analystcave.com/excel-calculate-distances-between-addresses/

Код

'Calculate Google Maps distance between two addresses
   Public Function GetDistance(start As String, dest As String)
       Dim firstVal As String, secondVal As String, lastVal As String
       firstVal = "http://maps.googleapis.com/maps/api/distancematrix/json?origins="
       secondVal = "&destinations="
       lastVal = "&mode=car&language=pl&sensor=false&key=YOUR_KEY"
       Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
       URL = firstVal & Replace(start, " ", "+") & secondVal & Replace(dest, " ", "+") & 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"".*?([0-9]+)": regex.Global = False
       Set matches = regex.Execute(objHTTP.responseText)
       tmpVal = Replace(matches(0).SubMatches(0), ".", Application.International(xlListSeparator))
       GetDistance = CDbl(tmpVal)
       Exit Function
   ErrorHandl:
       GetDistance = -1
   End Function

Каждый раз, когда я применяю формулу, я получаю «-1», то есть ошибку сообщение.

2. Подход Нашел по: https://syntaxbytetutorials.com/excel-function-to-calculate-distance-using-google-maps-api-with-vba/

Здесь я также добавил VBA- JSON и активировал ссылки, как предложено автором.

Код


' Returns the number of seconds it would take to get from one place to another
Function TRAVELDISTANCE(origin, destination, apikey)

    Dim strUrl As String
    strUrl = "https://maps.googleapis.com/maps/api/directions/json?origin=" & origin & "&destination=" & destination & "&key=" & apikey

    Set httpReq = CreateObject("MSXML2.XMLHTTP")
    With httpReq
         .Open "GET", strUrl, False
         .Send
    End With

    Dim response As String
    response = httpReq.ResponseText

    Dim parsed As Dictionary
    Set parsed = JsonConverter.ParseJson(response)
    Dim meters As Integer

    Dim leg As Dictionary


    For Each leg In parsed("routes")(1)("legs")
        meters = meters + leg("distance")("value")
    Next leg



    TRAVELDISTANCE = meters

End Function 

Здесь функции фактически не компилируются из-за ошибки в строке
strUrl = "https://maps.googleapis.com/maps/api/directions/json?origin=" & origin & "&destination=" & destination & "&key=" & apikey

Возвращает ошибку «Ожидается: конец оператора».

Я полностью потерян и был бы очень благодарен, если бы кто-нибудь из вас смог оказать некоторую помощь.

Best, Felix

1 Ответ

0 голосов
/ 12 марта 2020

Что касается второго подхода, согласно this , URL должен выглядеть следующим образом:

https://maps.googleapis.com/maps/api/directions/json?origin=Disneyland&destination=Universal+Studios+Hollywood&key=YOUR_API_KEY

Итак, в вашем случае, если у вас есть переменная с именем origin, другая с именем destination и третья с именем apikey, URL должен быть построен следующим образом:

strUrl ="https://maps.googleapis.com/maps/api/directions/json?origin=" & origin & "&destination=" & destination & "&key=" & apikey

Функция должна быть вызвана так, например:

call TRAVELDISTANCE("Disneyland", "Universal+Studios+Hollywood", "xxxxx")

Полагаю, произошло то, что на веб-сайте, где вы нашли исходный код, символ & был разрешен в HTML версии, которая: &. Это, однако, приведет к ошибке в VBA.

Поэтому, прежде чем копировать и вставлять что-то, вам нужно понять, как это работает.

Для объединения строк в целом применяется следующее:

finalString= String1 & String2 & "String3" & "String4" & ..... 'depending on whether your strings are stored in variables or not.
...