时间戳

首页 > 解决方案 > 在 Excel (VBA) 中使用 Google API 计算地址之间的距离

excel - 在 Excel (VBA) 中使用 Google API 计算地址之间的距离

问题描述

我正在写我的硕士论文，真的需要你的帮助来计算一些距离。

为了计算几个地址之间的距离（约 10k 对），我在网上找到了一些代码，我真的很挣扎。我从两个网站尝试了两个不同的代码，它们都给了我一个错误。

我已经创建了自己的 Google API，并激活了计费（使用 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

它返回“预期：语句结束”错误。

我完全迷失了，如果你们中的任何人能提供一些帮助，我将不胜感激。

最好的，菲利克斯

标签： excelvbagoogle-maps-api-3

解决方案

就第二种方法而言，根据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.

推荐阅读