使用较lessAPI调用的Excel上的Google Maps Distance Matrix API

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

我目前使用的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的调用限制。

有没有一种方法可以让函数只在特定的时间(例如点击一个button)提取数据,或者只是在较less的API调用中获取相同的数据?

通过添加一个button(只刷新,如果它被按下)和一个集合,持有迄今所有的值,你应该能够减less呼叫的方式…

 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(如果你明白我的意思…

如果你仍然有问题,只要问:)