问在Excel上使用Google Maps Distance Matrix API，只需较少的API调用

EN

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