在谷歌中使用邮政编码找到距离

时间:2013-02-07 14:07:10

标签: excel-vba vba excel

我有这个VBA脚本,我一直试图通过点击按钮给我一个距离

工作表名称为inputwks,我已定义了名为C_postD_postMiles的单元格。 我试图将VBA脚本中的C01设置为C_postC02的值,使其成为D_post的值,并将距离设置为Miles }

Sub GetDistance()

Dim inputWks As Worksheet
Dim c01 As Range
Dim c02 As Range
Dim Miles As Range
Dim distance As Range

'Set distance = inputWks.Range("Miles")


Set c01 = inputWks.Range("C_post")
Set c02 = inputWks.Range("D_post")
'Set Miles = inputWks.Range("Miles")

Application.EnableEvents = False

'c01 As String, c02 As String) As Double
With inputWks

With CreateObject("MSXML2.XMLHTTP")
    .Open "Get", "http://maps.google.co.uk/maps?f=d&source=s_d&saddr=" & c01 & "&daddr=" & c02
    .send

Do: DoEvents: Loop Until .readyState = 4

     If InStr(.responseText, "mi</span>") <> 0 Then _
         distance = Val(Split(Split(Split(.responseText, "<div class=""dir-altroute-inner"">")(1), "<span>")(1), "</span>")(0))
    .abort
End With

End With


inputWks.Range("Miles") = distance
Application.EnableEvents = True

End Sub

原始的marco看起来像这样

Public Function Getdistance(c01 As String, c02 As String) As Double
With CreateObject("MSXML2.XMLHTTP")
    .Open "Get", "http://maps.google.co.uk/maps?f=d&source=s_d&saddr=" & c01 & "&daddr=" & c02
    .send


Do: DoEvents: Loop Until .readyState = 4

If InStr(.responseText, "mi</span>") <> 0 Then _
    Getdistance = Val(Split(Split(Split(.responseText, "<div class=""dir-altroute-inner"">")(1), "<span>")(1), "</span>")(0))
.abort
End With
End Function
    Application.EnableEvents = True
End Function

1 个答案:

答案 0 :(得分:0)

我在这里完成了答案

Sub GetDistance()

Dim inputWks As Worksheet
Dim c01 As Range
Dim c02 As Range
Dim Miles As Range
Dim distance As Long

'Set distance = inputWks.Range("Miles")

Set inputWks = Worksheets("Input")
Set c01 = inputWks.Range("C_post")
Set c02 = inputWks.Range("D_post")
Set Miles = inputWks.Range("Miles")

Application.EnableEvents = False


With inputWks

With CreateObject("MSXML2.XMLHTTP")
    .Open "Get", "http://maps.google.co.uk/maps?f=d&source=s_d&saddr=" & c01 & "&daddr=" & c02
     .send

Do: DoEvents: Loop Until .readyState = 4

  If InStr(.responseText, "mi</span>") <> 0 Then _
         distance = Val(Split(Split(Split(.responseText, "<div class=""dir-altroute-inner"">")(1), "<span>")(1), "</span>")(0))
     .abort
End With


End With

    Miles = distance
    Application.EnableEvents = True

End Sub