在Excel上使用Google Maps距离矩阵API和更少的API调用

Question

我创建的Excel电子表格的一部分是由8个不同位置组成的网格，它们之间的距离是从Google Maps Distance Matrix API中提取的。这些地点是从一张桌子输入的，并会定期更改。

我目前使用的VBA代码：

'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 = "+UK&destinations=" 
    lastVal = "+UK&mode=car&language=en&sensor=false" 
    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 

然后我用简单的函数调用它在电子表格中：

=GetDistance($D$14,B15) 

这个脚本运行良好，但它确实意味着我每次电子表格加载并每次更改任何位置时都会执行56次API调用，因此我很快就达到了2500次API调用限制。

有没有一种方法可以让函数只在特定的时间（例如点击一个按钮）拉取数据，或者只是在较少的API调用中获取相同的数据？

Answer 1

通过添加按钮（仅当按下它刷新）和集合抱着你走到这一步，所有的值，你应该能够降低通话的amounds ...

Option Explicit 

Public gotRanges As New Collection 'the collection which holds all the data 
Public needRef As Range 'the ranges which need to be recalculated 
Public refMe As Boolean 'if true GetDistance will update if not in collection 

Public Function GetDistance(start As String, dest As String) 
    Dim firstVal As String, secondVal As String, lastVal As String, URL As String, tmpVal As String 
    Dim runner As Variant, objHTTP, regex, matches 
    If gotRanges.Count > 0 Then 
    For Each runner In gotRanges 
     If runner(0) = start And runner(1) = dest Then 
     GetDistance = runner(2) 
     Exit Function 
     End If 
    Next 
    End If 
    If refMe Then 
    firstVal = "http://maps.googleapis.com/maps/api/distancematrix/json?origins=" 
    secondVal = "+UK&destinations=" 
    lastVal = "+UK&mode=car&language=en&sensor=false" 
    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) 
    gotRanges.Add Array(start, dest, GetDistance) 
    Exit Function 
    Else 
    If needRef Is Nothing Then 
     Set needRef = Application.Caller 
    Else 
     Set needRef = Union(needRef, Application.Caller) 
    End If 
    End If 
ErrorHandl: 
    GetDistance = -1 
End Function 

Public Sub theButtonSub() 'call this to update the actual settings 
    Dim runner As Variant 
    refMe = True 
    If Not needRef Is Nothing Then 
    For Each runner In needRef 
     runner.Offset.Formula = runner.Formula 
    Next 
    End If 
    Set needRef = Nothing 
    refMe = False 
End Sub 

有，B和C（这将加载6次）将不会再次加载，如果你改变它们为C，A和B（如果你明白我的意思...

如果你仍然有问题，只是问:)