EXCEL与百度地图网页的数据对接，批量处理求助

雨中的回忆

有多个起始点（例如100个），一个目的地（或者多个？也想知道如何实现，呵呵），需要知道之间各的路线距离

如果手工查，需要大量精力和时间

图片中的例子是手工查找得到数据64.4公里

手工做的话，我需要做一个3列的表格，记录起始点和目的地，查好了以后将网页的数据人工输入表中

目标：

A、在EXCEL中输入起始点和目的地，运算宏，得到距离（1个起始点1个目的地实现也可以，VBA我略有小基础，可以自己实现剩余的语句）

B、在EXCEL中输入多个起始点和目的地，运算宏，批量得到距离（有就向前辈学习，提高自己）

实在是对EXCEL VBA和网页的数据接口不懂，特此请教，希望有前辈能为我解惑开导，先谢谢了！
不知道我说明的目的，大家懂了没有？应该说的比较清楚了- -，希望高手出现


附件： 自动抓取地图数据.zip (143.13 KB, 下载次数: 680)

2014-7-31 22:10 上传

点击文件名下载附件
说明

suwenkai

试了一下，不知道行不行。

1. Sub 按钮1_Click()
   
2.     Dim url, js, lastRow
   
3.     lastRow = Range("b1048576").End(xlUp).Row
   
4.     For i = 2 To lastRow
   
5.         url = "http://map.baidu.com/?newmap=1&reqflag=pcmap&biz=1&from=webmap&"
   
6.         url = url & "qt=nav&da_src=pcmappg.searchBox.button&c=289&sn=2$$$"
   
7.         url = url & Cells(i, 2) '这里是开始地址
   
8.         url = url & "$0$$&en=2$$$"
   
9.         url = url & Cells(i, 3)   '这里是结束地址
   
10.         url = url & "$0$$&sc=289&ec=289&rn=5&time_index=-1&day=-1&extinfo=63&tn=B_NORMAL_MAP"
    
11.         url = url & "&nn=0&ie=utf-8&l=18&&t=1406857726467"
    
12.         Set js = CreateObject("scriptcontrol")
    
13.         js.Language = "jscript"
    
14.         With CreateObject("msxml2.xmlhttp")
    
15.             .Open "get", url, False
    
16.             .send
    
17.             tt = .responsetext
    
18.             js.eval ("qd=" & tt)
    
19.             Cells(i, 4) = js.eval("qd.content.dis") / 1000 & "公里"
    
20. 
    
21.         End With
    
22.     Next
    
23. End Sub
    

复制代码

雨中的回忆

suwenkai 发表于 2014-8-1 10:20
试了一下，不知道行不行。

自动抓取地图数据.rar (17.78 KB, 下载次数: 251)

2014-8-1 13:05 上传

点击文件名下载附件

非常感谢 Thanks a lot!

如果您时间有余并愿意的话，希望能在语句后面略注解，我作为一个学习文件了：）

另，有个新情况，百度地图查出来之后，有“推荐路线，最短路线，不走高架”，希望可以自动得出3个数据
详见附件，不知道可不可以实现？麻烦了！

雨中的回忆

suwenkai 发表于 2014-8-1 10:20
试了一下，不知道行不行。

另，我仔细测试了一下，不知道如下问题能否改进？

地图中起始点或者目的地如果地址有“号”
可能出现多个选择起点（见图片）
我尝试了一下，只有到“路”或者“市”，“区”才能自动出现数字（见附件）
（将起始点或目的地文字表述地址，删除后面的明细“路”或“号”）
宏语句中是否可以实现默认选择第一个？


（这样就不用将地址简化，可以精确点）

suwenkai

雨中的回忆 发表于 2014-8-1 13:04
非常感谢 Thanks a lot!

如果您时间有余并愿意的话，希望能在语句后面略注解，我作为一个学习文件了 ...

1. Sub 按钮1_Click()
   
2.     Dim url, js, lastRow
   
3.     lastRow = Range("b1048576").End(xlUp).Row
   
4.     For i = 2 To lastRow
   
5.         url = "http://map.baidu.com/?newmap=1&reqflag=pcmap&biz=1&from=webmap&sy=2&" 'sy的0，1，2控制的，自己修改
   
6.         url = url & "qt=nav&da_src=pcmappg.searchBox.button&c=289&sn=2$$$"
   
7.         url = url & Cells(i, 2)    '这里是开始地址
   
8.         url = url & "$0$$&en=2$$$"
   
9.         url = url & Cells(i, 3)   '这里是结束地址
   
10.         url = url & "$0$$&sc=289&ec=289&rn=5&time_index=-1&day=-1&extinfo=63&tn=B_NORMAL_MAP"
    
11.         url = url & "&nn=0&ie=utf-8&l=18&&t=1406857726467"
    
12.         Set js = CreateObject("scriptcontrol")
    
13.         js.Language = "jscript"
    
14.         With CreateObject("msxml2.xmlhttp")
    
15.             .Open "get", url, False
    
16.             .send
    
17.             tt = .responsetext
    
18.             js.eval ("qd=" & tt)
    
19.             Cells(i, 4) = js.eval("qd.content.dis") / 1000 & "公里"
    
20.         End With
    
21.     Next
    
22. End Sub
    

复制代码

suwenkai

雨中的回忆 发表于 2014-8-1 13:30
另，我仔细测试了一下，不知道如下问题能否改进？

地图中起始点或者目的地如果地址有“号”

没办法 ，这个我做不到

雨中的回忆

suwenkai 发表于 2014-8-1 19:51
没办法 ，这个我做不到

那么如果抓取左边起点多个选项的数据可以吗？

例如抓取前面3个或者全部抓取

又要麻烦您，谢谢了

suwenkai

有多个选择的放到e2单元格。

1. Sub 按钮1_Click()
   
2.     Dim url, js, lastRow
   
3.     lastRow = Range("b1048576").End(xlUp).Row
   
4.     For i = 2 To lastRow
   
5.         url = "http://map.baidu.com/?newmap=1&reqflag=pcmap&biz=1&from=webmap&sy=0&"
   
6.         url = url & "qt=nav&da_src=pcmappg.searchBox.button&c=289&sn=2$$$"
   
7.         url = url & Cells(i, 2)    '这里是开始地址
   
8.         url = url & "$0$$&en=2$$$"
   
9.         url = url & Cells(i, 3)   '这里是结束地址
   
10.         url = url & "$0$$&sc=289&ec=289&rn=5&time_index=-1&day=-1&extinfo=63&tn=B_NORMAL_MAP"
    
11.         url = url & "&nn=0&ie=utf-8&l=18&&t=1406857726467"
    
12.         Set js = CreateObject("scriptcontrol")
    
13.         js.Language = "jscript"
    
14.         With CreateObject("msxml2.xmlhttp")
    
15.             .Open "get", url, False
    
16.             .send
    
17.             tt = .responsetext
    
18.             js.eval ("qd=" & tt)
    
19.             Cells(i, 4) = js.eval("qd.content.dis") / 1000 & "公里"
    
20.             If js.eval("qd.content.dis") = 0 Then
    
21.                 Cells(i, 5).ClearContents
    
22.                 t = js.eval("qd.content[0].length")
    
23.                 For j = 0 To t - 1
    
24.                     Cells(i, 5) = Cells(i, 5) & js.eval("qd.content[0][" & j & "].name")
    
25.                 Next
    
26.             End If
    
27.         End With
    
28.     Next
    
29. End Sub
    

复制代码

xuekui1314

您好 如果把百度地图换成SOGOU需要如何操作呢？

onlycxb

xuekui1314 发表于 2015-8-28 09:55
您好 如果把百度地图换成SOGOU需要如何操作呢？

换其他搜索软件，也需要抓包分析，然后定制相应的代码就可实现。