String 将googlemap应用到excel中

这是我的第一个问题，所以我正在重新编辑以更好地适应堆栈溢出中的文化！ 我最近发现了下面的API，它可以帮助我规划各种活动的行程/站点。它在excel上为我提供了距离、方向和时间！我有各种各样的地址，我使用，我需要在excel格式的每个数据

问题：我有一个问题，我想根据时间和日期找出我到达下一个地点的时间/持续时间。例如，如果我想在下午4点离开多伦多去芝加哥，根据平均交通记录，需要多长时间

这与其他需要在excel中对信息进行地理编码的人非常相关！我对编程、vba和sql不是很熟悉，但我肯定想进入其中，所以这是学习一些很酷的东西的好的踏脚石

' Usage :
' GetGoogleTravelTime (strFrom, strTo) returns a string containing journey duration : hh:mm
' GetGoogleDistance (strFrom, strTo) returns a string containing journey distance in either miles or km (as defined by strUnits)
' GetGoogleDirections (strFrom, strTo) returns a string containing the directions
'
' where strFrom/To are address search terms recognisable by Google
' i.e. Postcode, address etc.
'
'
Const strUnits = "imperial" ' imperial/metric (miles/km)

Function CleanHTML(ByVal strHTML)
'Helper function to clean HTML instructions
Dim strInstrArr1() As String
Dim strInstrArr2() As String
Dim s As Integer

strInstrArr1 = Split(strHTML, "<")
For s = LBound(strInstrArr1) To UBound(strInstrArr1)
   strInstrArr2 = Split(strInstrArr1(s), ">")
   If UBound(strInstrArr2) > 0 Then
        strInstrArr1(s) = strInstrArr2(1)
   Else
        strInstrArr1(s) = strInstrArr2(0)
   End If
Next

CleanHTML = Join(strInstrArr1)
End Function

Public Function formatGoogleTime(ByVal lngSeconds As Double)
'Helper function. Google returns the time in seconds, so this converts it into time format hh:mm

Dim lngMinutes As Long
Dim lngHours As Long

lngMinutes = Fix(lngSeconds / 60)
lngHours = Fix(lngMinutes / 60)
lngMinutes = lngMinutes - (lngHours * 60)

formatGoogleTime = Format(lngHours, "00") & ":" & Format(lngMinutes, "00")
End Function




Function gglDirectionsResponse(ByVal strStartLocation, ByVal strEndLocation, ByRef strTravelTime, ByRef strDistance, ByRef strInstructions, Optional ByRef strError = "") As Boolean
On Error GoTo errorHandler
' Helper function to request and process XML generated by Google Maps.

Dim strURL As String
Dim objXMLHttp As Object
Dim objDOMDocument As Object
Dim nodeRoute As Object
Dim lngDistance As Long

Set objXMLHttp = CreateObject("MSXML2.XMLHTTP")
Set objDOMDocument = CreateObject("MSXML2.DOMDocument.6.0")

strStartLocation = Replace(strStartLocation, " ", "+")
strEndLocation = Replace(strEndLocation, " ", "+")

strURL = "http://maps.googleapis.com/maps/api/directions/xml" & _
            "?origin=" & strStartLocation & _
            "&destination=" & strEndLocation & _
            "&sensor=false" & _
            "&units=" & strUnits   'Sensor field is required by google and indicates whether a Geo-sensor is being used by the device making the request

'Send XML request
With objXMLHttp
    .Open "GET", strURL, False
    .setRequestHeader "Content-Type", "application/x-www-form-URLEncoded"
    .Send
    objDOMDocument.LoadXML .ResponseText
End With

With objDOMDocument
    If .SelectSingleNode("//status").Text = "OK" Then
        'Get Distance
        lngDistance = .SelectSingleNode("/DirectionsResponse/route/leg/distance/value").Text ' Retrieves distance in meters
        Select Case strUnits
            Case "imperial": strDistance = Round(lngDistance * 0.00062137, 1)  'Convert meters to miles
            Case "metric": strDistance = Round(lngDistance / 1000, 1) 'Convert meters to miles
        End Select

        'Get Travel Time
        strTravelTime = .SelectSingleNode("/DirectionsResponse/route/leg/duration/value").Text  'returns in seconds from google
        strTravelTime = formatGoogleTime(strTravelTime) 'converts seconds to hh:mm

        'Get Directions
        For Each nodeRoute In .SelectSingleNode("//route/leg").ChildNodes
            If nodeRoute.BaseName = "step" Then
                strInstructions = strInstructions & nodeRoute.SelectSingleNode("html_instructions").Text & " - " & nodeRoute.SelectSingleNode("distance/text").Text & vbCrLf
            End If
        Next

        strInstructions = CleanHTML(strInstructions) 'Removes MetaTag information from HTML result to convert to plain text.

    Else
        strError = .SelectSingleNode("//status").Text
        GoTo errorHandler
    End If
End With

gglDirectionsResponse = True
GoTo CleanExit

errorHandler:
    If strError = "" Then strError = Err.Description
    strDistance = -1
    strTravelTime = "00:00"
    strInstructions = ""
    gglDirectionsResponse = False

CleanExit:
    Set objDOMDocument = Nothing
    Set objXMLHttp = Nothing

End Function


Function getGoogleTravelTime(ByVal strFrom, ByVal strTo) As String
'Returns the journey time between strFrom and strTo

Dim strTravelTime As String
Dim strDistance As String
Dim strInstructions As String
Dim strError As String

If gglDirectionsResponse(strFrom, strTo, strTravelTime, strDistance, strInstructions, strError) Then
    getGoogleTravelTime = strTravelTime
Else
    getGoogleTravelTime = strError
End If

End Function

Function getGoogleDistance(ByVal strFrom, ByVal strTo) As String
'Returns the distance between strFrom and strTo
'where strFrom/To are address search terms recognisable by Google
'i.e. Postcode, address etc.

Dim strTravelTime As String
Dim strDistance As String
Dim strError As String
Dim strInstructions As String

If gglDirectionsResponse(strFrom, strTo, strTravelTime, strDistance, strInstructions, strError) Then
    getGoogleDistance = strDistance
Else
    getGoogleDistance = strError
End If

End Function

Function getGoogleDirections(ByVal strFrom, ByVal strTo) As String
'Returns the directions between strFrom and strTo
'where strFrom/To are address search terms recognisable by Google
'i.e. Postcode, address etc.

Dim strTravelTime As String
Dim strDistance As String
Dim strError As String
Dim strInstructions As String

If gglDirectionsResponse(strFrom, strTo, strTravelTime, strDistance, strInstructions, strError) Then
    getGoogleDirections = strInstructions
Else
    getGoogleDirections = strError
End If

End Function

”用法：
'GetGoogleTravelTime（strFrom，strTo）返回一个字符串，其中包含行程持续时间：hh:mm
'GetGoogleDistance（strFrom，strTo）返回一个字符串，该字符串包含以英里或公里为单位的旅程距离（由strUnits定义）
'GetGoogleDirections（strFrom，strTo）返回一个包含方向的字符串
'
其中strFrom/To是谷歌可以识别的地址搜索词
“即邮政编码、地址等。
'
'
常量strUnits=“英制”英制/公制（英里/公里）
函数CleanHTML（ByVal strHTML）
'清除HTML指令的帮助函数
将strInstrArr1（）设置为字符串
Dim strInstrArr2（）作为字符串
将s变为整数
strInstrArr1=拆分（strHTML，“”）
如果UBound（strInstrArr2）>0，则
strInstrArr1（s）=strInstrArr2（1）
其他的
strInstrArr1（s）=strInstrArr2（0）
如果结束
下一个
CleanHTML=Join（strInstrArr1）
端函数
公用函数格式GoogleTime（ByVal lngSeconds为双精度）
'辅助函数。谷歌以秒为单位返回时间，因此这会将其转换为时间格式hh:mm
暗淡的lng分钟与长
昏暗的长廊
lngMinutes=固定（lngSeconds/60）
lngHours=固定（Lngmin/60）
lngMinutes=lngMinutes-（lngHours*60）
formatGoogleTime=格式（lngHours，“00”）&“&格式（lngMinutes，“00”）
端函数
函数方向响应（ByVal strStartLocation、ByVal strengdlocation、ByRef strTravelTime、ByRef strInstance、ByRef strInstructions、可选ByRef strError=“”）为布尔值
关于错误转到错误处理程序
'Helper函数，用于请求和处理Google Maps生成的XML。
暗弦
Dim objXMLHttp作为对象
Dim objDOMDocument作为对象
作为对象的Dim nodeRoute
暗距离与长距离相同
设置objXMLHttp=CreateObject（“MSXML2.XMLHTTP”）
设置objDOMDocument=CreateObject（“MSXML2.DOMDocument.6.0”）
strStartLocation=替换（strStartLocation，“，”+”）
strEndLocation=更换（strEndLocation，“，”+”）
strURL=”http://maps.googleapis.com/maps/api/directions/xml" & _
“？原点=”&strStartLocation&_
“&destination=“&strengdlocation&_
“&sensor=false”&_
“&units=“&strUnits”传感器字段是google所必需的，它指示发出请求的设备是否正在使用地理传感器
'发送XML请求
使用objXMLHttp
.打开“获取”，strURL，False
.setRequestHeader“内容类型”、“应用程序/x-www-form-URLEncoded”
.发送
objDOMDocument.LoadXML.ResponseText
以
使用objDOMDocument
如果.SelectSingleNode（//status”）.Text=“确定”，则
“保持距离
lngDistance=.SelectSingleNode（“/DirectionsResponse/route/leg/distance/value”）。Text'检索以米为单位的距离
选择案例结构
案例“英制”：标准距离=圆形（lngDistance*0.00062137，1）'将米转换为英里
案例“公制”：标准距离=圆形（lngDistance/1000，1）'将米转换为英里
结束选择
“获得旅行时间
strTravelTime=.SelectSingleNode（“/DirectionsResponse/route/leg/duration/value”）.Text'以秒为单位从google返回
strTravelTime=formatGoogleTime（strTravelTime）'将秒转换为hh:mm
“问路
对于.SelectSingleNode（“//路由/分支”）.ChildNodes中的每个节点路由
如果nodeRoute.BaseName=“步骤”，则
strInstructions=strInstructions&nodeRoute.SelectSingleNode（“html_指令”）.Text&“-”&nodeRoute.SelectSingleNode（“距离/文本”）.Text&vbCrLf
如果结束
下一个
strInstructions=CleanHTML（strInstructions）'从HTML结果中删除元标记信息以转换为纯文本。
其他的
strError=.SelectSingleNode（//状态”）.Text
转到错误处理程序
如果结束
以
GlgDirectionsResponse=True
转到清洁出口
错误处理程序：
如果strError=”“，则strError=错误描述
标准状态=-1
strTravelTime=“00:00”
strInstructions=“”
GlgDirectionsResponse=False
清洁出口：
设置objDOMDocument=Nothing
设置objXMLHttp=Nothing
端函数
函数getGoogleTravelTime（ByVal strFrom，ByVal strTo）作为字符串
'返回strFrom和strTo之间的行程时间
作为字符串的Dim strTravelTime
作为字符串的Dim strDistance
作为字符串的模糊指令
朦胧如弦
如果是方向响应（strFrom、strTo、strTravelTime、strInstance、strInstructions、strError），则
getGoogleTravelTime=strTravelTime
其他的
getGoogleTravelTime=strError
如果结束
端函数
函数getGoogleDistance（ByVal strFrom，ByVal strTo）作为字符串
'返回strFrom和strTo之间的距离
其中strFrom/To是谷歌可以识别的地址搜索词
“即邮政编码、地址等。
作为字符串的Dim strTravelTime
作为字符串的Dim strDistance
朦胧如弦
作为字符串的模糊指令
如果是方向响应（strFrom、strTo、strTravelTime、strInstance、strInstructions、strError），则
getGoogleDistance=标准距离
其他的
getGoogleDistance=strError
如果结束
端函数
函数getGoogleDirections（ByVal strFrom，ByVal strTo）作为字符串
'返回strFrom和strTo之间的方向
'其中strFrom/To是地址搜索
' Usage :
' GetGoogleTravelTime (strFrom, strTo) returns a string containing journey duration : hh:mm
' GetGoogleDistance (strFrom, strTo) returns a string containing journey distance in either miles or km (as defined by strUnits)
' GetGoogleDirections (strFrom, strTo) returns a string containing the directions
'
' where strFrom/To are address search terms recognisable by Google
' i.e. Postcode, address etc.
'
' by Desmond Oshiwambo

Const strUnits = "imperial" ' imperial/metric (miles/km)

Function CleanHTML(ByVal strHTML)
'Helper function to clean HTML instructions
Dim strInstrArr1() As String
Dim strInstrArr2() As String
Dim s As Integer

strInstrArr1 = Split(strHTML, "<")
For s = LBound(strInstrArr1) To UBound(strInstrArr1)
 strInstrArr2 = Split(strInstrArr1(s), ">")
   If UBound(strInstrArr2) > 0 Then
        strInstrArr1(s) = strInstrArr2(1)
   Else
        strInstrArr1(s) = strInstrArr2(0)
   End If
Next

CleanHTML = Join(strInstrArr1)
End Function


Public Function formatGoogleTime(ByVal lngSeconds As Double)
'Helper function. Google returns the time in seconds, so this converts it into time format hh:mm

Dim lngMinutes As Long
Dim lngHours As Long

lngMinutes = Fix(lngSeconds / 60)
lngHours = Fix(lngMinutes / 60)
lngMinutes = lngMinutes - (lngHours * 60)

formatGoogleTime = Format(lngHours, "00") & ":" & Format(lngMinutes, "00")
End Function


Function gglDirectionsResponse(ByVal strStartLocation, ByVal strEndLocation, ByRef strTravelTime, ByRef strDistance, ByRef strInstructions, Optional ByRef strError = "") As Boolean
On Error GoTo errorHandler
' Helper function to request and process XML generated by Google Maps.

Dim strURL As String
Dim objXMLHttp As Object
Dim objDOMDocument As Object
Dim nodeRoute As Object
Dim lngDistance As Long

Set objXMLHttp = CreateObject("MSXML2.XMLHTTP")
Set objDOMDocument = CreateObject("MSXML2.DOMDocument.6.0")

strStartLocation = Replace(strStartLocation, " ", "+")
strEndLocation = Replace(strEndLocation, " ", "+")

strURL = "http://maps.googleapis.com/maps/api/directions/xml" & _
            "?origin=" & strStartLocation & _
            "&destination=" & strEndLocation & _
            "&sensor=false" & _
            "&units=" & strUnits   'Sensor field is required by google and indicates whether a Geo-sensor is being used by the device making the request

'Send XML request
With objXMLHttp
    .Open "GET", strURL, False
    .setRequestHeader "Content-Type", "application/x-www-form-URLEncoded"
    .send
    objDOMDocument.LoadXML .responseText
End With

With objDOMDocument
    If .SelectSingleNode("//status").Text = "OK" Then
        'Get Distance
        lngDistance = .SelectSingleNode("/DirectionsResponse/route/leg/distance/value").Text ' Retrieves distance in meters
        Select Case strUnits
            Case "imperial": strDistance = Round(lngDistance * 0.00062137, 1)  'Convert meters to miles
            Case "metric": strDistance = Round(lngDistance / 1000, 1) 'Convert meters to miles
        End Select

        'Get Travel Time
        strTravelTime = .SelectSingleNode("/DirectionsResponse/route/leg/duration/value").Text  'returns in seconds from google
        strTravelTime = formatGoogleTime(strTravelTime) 'converts seconds to hh:mm

        'Get Directions
        For Each nodeRoute In .SelectSingleNode("//route/leg").ChildNodes
            If nodeRoute.BaseName = "step" Then
                strInstructions = strInstructions & nodeRoute.SelectSingleNode("html_instructions").Text & " - " & nodeRoute.SelectSingleNode("distance/text").Text & vbCrLf
            End If
        Next

        strInstructions = CleanHTML(strInstructions) 'Removes MetaTag information from HTML result to convert to plain text.

    Else
        strError = .SelectSingleNode("//status").Text
        GoTo errorHandler
    End If
End With

gglDirectionsResponse = True
GoTo CleanExit

errorHandler:
    If strError = "" Then strError = Err.Description
    strDistance = -1
    strTravelTime = "00:00"
    strInstructions = ""
    gglDirectionsResponse = False

CleanExit:
    Set objDOMDocument = Nothing
    Set objXMLHttp = Nothing

End Function


Function getGoogleTravelTime(ByVal strFrom, ByVal strTo) As String
'Returns the journey time between strFrom and strTo

Dim strTravelTime As String
Dim strDistance As String
Dim strInstructions As String
Dim strError As String

If gglDirectionsResponse(strFrom, strTo, strTravelTime, strDistance, strInstructions, strError) Then
    getGoogleTravelTime = strTravelTime
Else
    getGoogleTravelTime = strError
End If

End Function


Function getGoogleDistance(ByVal strFrom, ByVal strTo) As String
'Returns the distance between strFrom and strTo
'where strFrom/To are address search terms recognisable by Google
'i.e. Postcode, address etc.

Dim strTravelTime As String
Dim strDistance As String
Dim strError As String
Dim strInstructions As String

If gglDirectionsResponse(strFrom, strTo, strTravelTime, strDistance, strInstructions, strError) Then
    getGoogleDistance = strDistance
Else
    getGoogleDistance = strError
End If

End Function


Function getGoogleDirections(ByVal strFrom, ByVal strTo) As String
'Returns the directions between strFrom and strTo
'where strFrom/To are address search terms recognisable by Google
'i.e. Postcode, address etc.

Dim strTravelTime As String
Dim strDistance As String
Dim strError As String
Dim strInstructions As String

If gglDirectionsResponse(strFrom, strTo, strTravelTime, strDistance, strInstructions, strError) Then
    getGoogleDirections = strInstructions
Else
    getGoogleDirections = strError
End If

End Function
Public Function ACOF(Rango As Range) As Variant
 Dim x(), y(), z() As Variant
 Dim i, n, mu, k, j As Double
  n = Rango.Rows.Count
  mu = Application.Average(Rango)
  k = 1
  ReDim z(n - k)
 Do Until k = n - 1
 ReDim x(n - k), y(n - k)
   For i = 1 To n - k Step 1
    x(i) = Rango(i) - mu
    y(i) = Rango(i + k) - mu
   Next i
z(k) = Application.Correl(x, y) 'Application.SumProduct(x, y) / Application.DevSq(Rango)
 k = k + 1
Loop
ACOF = Application.Transpose(z)
End Function

Public Function JBTEST(Rango As Range, p As Double) As Variant
 If IsNull(Rango) Then
  MsgBox prompt:="Introduce un rango válido"
   End If
 Dim s, k, n As Double
  s = Application.Skew(Rango)
  k = Application.Kurt(Rango)
  n = Rango.Rows.Count
   JBTEST = Application.ChiDist((n - p + 1) / 6 * (s ^ 2 + 1 / 4 * (k - 3) ^ 2), 2)

End Function

Function IFERROR(ByRef ToEvaluate As Variant, ByRef Default As Variant) As Variant
    If IsError(ToEvaluate) Then
        IFERROR = Default
    Else
        IFERROR = ToEvaluate
    End If
End Function

Sub RegisterUDF()
    Dim s As String
    s = "Provides a shortcut replacement for the common worksheet construct" & vbLf _
    & "IF(ISERROR(<expression>, <default>, <expression>)"

    Application.MacroOptions Macro:="IFERROR", Description:=s, Category:=9
End Sub

Sub UnregisterUDF()
    Application.MacroOptions Macro:="IFERROR", Description:=Empty, Category:=Empty
End Sub