给大家分享一个数据矿工写的VBA里程批量查询的小程序,具体的代码功能是根据百度地图URL中的GET方式进行查询,根据百度地图得到最终里程。
1、录入起点重点明细地址,再点击查询即可直接查询里程信息;2、本程序查询的并非是坐标计算的直线距离,而是实际的地图里程;3、有部分里程数据可能会因为起点终点有重名情况,此时默认是第一个;4、若显示里程为0,则可能地址并未找到,请更新明细或更换附近地址查询。
具体的宏代码如下:
Sub里程查询()
k=[a].End(xlUp).Row
OnErrorResumeNext
Fori=2Tok
CityFrom=Cells(i,1)
CityTo=Cells(i,2)
DimstrTextAsString
DimURLAsString
Dimdis,mtime
......
WithCreateObject("MSXML2.ServerXMLHTTP")
.Open"GET",URL,False
.Send
等待响应
DoWhile.readystate4
DoEvents
Loop
strText=.responsetext
dis=Val(Split(strText,"""dis"":")(1))
mtime=Val(Mid(strText,InStrRev(strText,"""time"":")+7))
Cells(i,3)=dis/
EndWith
Next
EndSub
文件下载原文引自: