如何读百度地图的地址，在单元格中，实现ctrl+k的超链接功能。

ning84

运行结果不对。

1. Sub OpenBaiduMapSearch()
   
2.     Dim keyword As String
   
3.     Dim url As String
   
4. 
   
5.     keyword = "珠海拱北"  'InputBox("请输入要在百度地图搜索的关键字：")
   
6.     If keyword = "" Then Exit Sub
   
7. 
   
8.     url = "https://map.baidu.com/?newmap=1&ie=utf-8&s=bt&wd=" & keyword
   
9. 
   
10.     Shell "explorer.exe " & url, vbNormalFocus
    
11. End Sub
    

复制代码

这段代码的工作原理如下：

• 首先通过 InputBox 函数弹出一个输入框，提示用户输入要在百度地图搜索的关键字。
• 如果用户没有输入任何内容（即输入为空字符串），则直接退出该过程。
• 然后根据用户输入的关键字构建百度地图的搜索链接，格式是将关键字添加到百度地图搜索链接的特定位置。
• 最后使用 Shell 命令，以默认方式打开指定的链接，也就是在浏览器中打开百度地图并显示针对该关键字的搜索结果。
  

请注意，此代码在运行时需要确保计算机已联网且默认浏览器设置正确，以便能够顺利打开百度地图的搜索页面。

ning84

必须好好学习这个代码

1. Sub OpenBaiduMapSearch()
   
2.     Dim keyword As String
   
3.     Dim url As String
   
4. 
   
5.     keyword = InputBox("请输入要在百度地图搜索的关键字：")
   
6.     If keyword = "" Then Exit Sub
   
7. 
   
8.     url = "https://map.baidu.com/?newmap=1&ie=utf-8&s=bt&wd=" & keyword
   
9. 
   
10.     Shell "explorer.exe " & url, vbNormalFocus
    
11. End Sub

复制代码

1. Sub 百度地图搜索拱北()
   
2.     Dim objson As Object, StrJs As String, url As String, p
   
3.     Cells.Clear
   
4.     Range("A1:C1") = Array("标题", "地址", "电话")
   
5.     Set objson = CreateObject("scriptcontrol")
   
6.     objson.Language = "javascript"
   
7.     ss$ = "拱北" ' 设置搜索关键字为拱北
   
8.     For p = 1 To 10
   
9.         url = "http://map.baidu.com/?newmap=1"
   
10.         url = url & "&reqflag=pcmap"
    
11.         url = url & "&biz=1"
    
12.         url = url & "&pcevaname=pc2"
    
13.         url = url & "&da_par=direct"
    
14.         url = url & "&from=webmap"
    
15.         url = url & "&qt=s"
    
16.         url = url & "&from=webmap"
    
17.         url = url & "&c=319" ' 这里可能需要根据实际情况调整城市代码
    
18.         url = url & "&wd=" & ss
    
19.         url = url & "&pn=" & p - 1
    
20.         url = url & "&db=0"
    
21.         url = url & "&sug=0"
    
22.         url = url & "&da_src=pcmappg.poi.page"
    
23.         url = url & "&on_gel=1"
    
24.         url = url & "&src=7"
    
25.         url = url & "&gr=3"
    
26.         url = url & "&l=13"
    
27.         url = url & "&addr=0"
    
28.         url = url & "&nn=" & (p - 1) * 10
    
29.         url = url & "&ie=utf-8"
    
30.         url = url & "&t=1428490938134"
    
31.         With CreateObject("msxml2.xmlhttp")
    
32.             .Open "GET", url, False
    
33.             .Send
    
34.             StrJs = "var a=" & .ResponseText & ";var s=''; for(x in a.content){ s+=a.content[x].name+'\t'+a.content[x].addr+'\t'+a.content[x].tel+'\r';}"
    
35.             StrJs = objson.Eval(StrJs)
    
36.         End With
    
37.         With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    
38.             .SetText StrJs
    
39.             .PutInClipboard
    
40.         End With
    
41.         With ActiveSheet
    
42.             .Cells(Rows.Count, 1).End(xlUp).Offset(1).Select
    
43.             .Paste
    
44.         End With
    
45.     Next p
    
46. End Sub

复制代码

ning84

就这个点过不去。

利用Excel将百度地图搜索结果导出_百度地图搜索结果导出excel-CSDN博客  https://blog.csdn.net/dvdstd/article/details/80338101

1. Sub baiduMap()
   
2. 
   
3.     Dim url, html, js
   
4. 
   
5.     Cells.ClearContents
   
6. 
   
7.     br = [{"店名","地址","电话"}]
   
8. 
   
9.     Range("a1:c1") = br
   
10. 
    
11.     url = ""
    
12. 
    
13.     Set html = CreateObject("htmlfile")
    
14. 
    
15.     Set js = CreateObject("scriptcontrol")
    
16. 
    
17.     js.Language = "jscript"
    
18. 
    
19.     For p = 1 To 5
    
20. 
    
21.         With CreateObject("msxml2.xmlhttp")
    
22. 
    
23.             url = "http://map.baidu.com/?newmap=1"
    
24. 
    
25.             url = url & "&reqflag=pcmap"
    
26. 
    
27.             url = url & "&biz=1"
    
28. 
    
29.             url = url & "&from=webmap"
    
30. 
    
31.             url = url & "&qt=s"
    
32. 
    
33.             url = url & "&from=webmap"
    
34. 
    
35.             url = url & "&c=257"
    
36. 
    
37.             url = url & "&pl_data_type=cater"
    
38. 
    
39.             url = url & "&pl_sub_type=餐饮"
    
40. 
    
41.             url = url & "&pl_price_section=0%2C%2B"
    
42. 
    
43.             url = url & "&pl_sort_type=data_type"
    
44. 
    
45.             url = url & "&pl_sort_rule=0"
    
46. 
    
47.             url = url & "&pl_discount2_section=0%2C%2B"
    
48. 
    
49.             url = url & "&pl_groupon_section=0%2C%2B"
    
50. 
    
51.             url = url & "&pl_cater_book_pc_section=0%2C%2B"
    
52. 
    
53.             url = url & "&pl_ticket_book_flag_section=0%2C%2B"
    
54. 
    
55.             url = url & "&pl_movie_book_section=0%2C%2B"
    
56. 
    
57.             url = url & "&pl_business_type=cater"
    
58. 
    
59.             url = url & "&pl_business_id="
    
60. 
    
61.             url = url & "&pl_activity_gwj_section=0%2C%2B"
    
62. 
    
63.             url = url & "&wd=餐饮"
    
64. 
    
65.             url = url & "&pn=1"
    
66. 
    
67.             url = url & "&db=0"
    
68. 
    
69.             url = url & "&wd2="
    
70. 
    
71.             url = url & "&sug=0"
    
72. 
    
73.             url = url & "&da_src=pcmappg.poi.page"
    
74. 
    
75.             url = url & "&on_gel=1"
    
76. 
    
77.             url = url & "&src=7"
    
78. 
    
79.             url = url & "&gr=3"
    
80. 
    
81. 
    
82. 
    
83.             url = url & "&l=12"
    
84. 
    
85.             url = url & "&addr=0"
    
86. 
    
87.             url = url & "&nn=" & (p - 1) * 10
    
88. 
    
89.             url = url & "&tn=B_NORMAL_MAP"
    
90. 
    
91.             url = url & "&ie=utf-8"
    
92. 
    
93.             url = url & "&t=1412423900383"
    
94. 
    
95.             .Open "get", url, False
    
96. 
    
97.             .send
    
98. 
    
99.             js.addcode ("suwenkai = " & .responsetext)
    
100. 
     
101. 
     
102. 
     
103.             slen = js.eval("suwenkai.content.length") - 1
     
104. 
     
105.             For i = 0 To slen
     
106. 
     
107.                 n = n + 1
     
108. 
     
109.                 Cells(n + 1, 1) = js.eval("suwenkai.content[" & i & "].name")
     
110. 
     
111.                 Cells(n + 1, 2) = js.eval("suwenkai.content[" & i & "].addr")
     
112. 
     
113.                 Cells(n + 1, 3) = js.eval("suwenkai.content[" & i & "].tel")
     
114. 
     
115.             Next
     
116. 
     
117.         End With
     
118. 
     
119.     Next
     
120. 
     
121. End Sub
     

复制代码

ning84

自学太难，成熟的代码，没办法解决。





[color=rgba(0, 0, 0, 0.85)]这段代码通过SendKeys[color=rgba(0, 0, 0, 0.85)]语句模拟用户在键盘上输入关键字、按下 TAB 键切换焦点以及按下回车键进行搜索的操作，但这种方法相对不够稳定，可能会受到系统环境和焦点等因素的影响9[color=rgba(0, 0, 0, 0.85)].

1. Sub SimulateUserSearch()
   
2.     Dim ie As Object
   
3.     Set ie = CreateObject("InternetExplorer.Application")
   
4.     ie.Visible = True
   
5.     ie.Navigate "http://map.baidu.com/"
   
6.     While ie.Busy Or ie.ReadyState <> 4
   
7.         DoEvents
   
8.     Wend
   
9.    
   
10.     SendKeys "拱北"
    
11.     SendKeys "{TAB}"
    
12.     SendKeys "{ENTER}"
    
13. End Sub

复制代码

1. Sub BaiduMapSearchByElement()
   
2.     Dim ie As Object
   
3.     Set ie = CreateObject("InternetExplorer.Application")
   
4.     ie.Visible = True
   
5.     ie.Navigate "http://map.baidu.com/"
   
6.     While ie.Busy Or ie.ReadyState <> 4
   
7.         DoEvents
   
8.     Wend
   
9.     Dim searchBox As Object
   
10.     Set searchBox = ie.Document.querySelector(".searchbox-input")
    
11.     searchBox.Value = "拱北"
    
12.     Dim searchButton As Object
    
13.     Set searchButton = ie.Document.querySelector(".searchbox-searchbutton")
    
14.     searchButton.Click
    
15. End Sub

复制代码

[color=rgba(0, 0, 0, 0.85)]利用querySelector[color=rgba(0, 0, 0, 0.85)]方法通过 CSS 选择器来获取百度地图页面中的搜索框和搜索按钮元素，并进行相应的输入关键字和点击搜索操作169[color=rgba(0, 0, 0, 0.85)].

ning84

没人教，成熟的小程序，就是过不去。纯粹是瞎扯淡。

1. Sub GetBaiduMapSearchResult()
   
2.     Dim objXMLHTTP As Object
   
3.     Dim strURL As String
   
4.     Dim strResult As String
   
5.     Set objXMLHTTP = CreateObject("MSXML2.XMLHTTP")
   
6.     strURL = "http://map.baidu.com/?wd=拱北"
   
7.     objXMLHTTP.Open "GET", strURL, False
   
8.     objXMLHTTP.Send
   
9.     strResult = objXMLHTTP.responseText
   
10.     ' 对获取到的结果进行进一步处理和分析
    
11.     Set objXMLHTTP = Nothing
    
12. End Sub
    
13. Sub OpenBaiduMapAndSearch()
    
14.     Dim ie As Object
    
15.     Set ie = CreateObject("InternetExplorer.Application")
    
16.     ie.Visible = True
    
17.     ie.Navigate "http://map.baidu.com/"
    
18.     While ie.Busy Or ie.ReadyState <> 4
    
19.         DoEvents
    
20.     Wend
    
21.     ie.Document.getElementById("search-key").Value = "拱北"
    
22.     ie.Document.getElementById("search-button").Click
    
23. End Sub

复制代码

ning84

没人教，花了很大功夫，还是不行。反复使用AI就是看着要实现目标，就是结果不对。、、、
难难难

要在VBA中使用关键地名搜索百度地图，你可以参考以下步骤和代码示例：

• 获取百度地图API密钥（AK）：你需要先在百度地图开放平台注册并获取一个API密钥（AK）。这个密钥将用于你的请求中，以验证你的身份。

• 编写VBA代码：你可以使用VBA编写一个宏，通过百度地图API进行地名搜索。以下是一个简单的VBA代码示例，用于在Excel中搜索地名并返回结果：

  
  

[backcolor=var(--fill-6)]vba
Sub SearchBaiduMap()    Dim url As String    Dim Str1 As String    Dim Str2 As String    Dim i As Integer    Dim responseText As String    Dim js As Object    Dim html As Object        ' 设置百度地图API密钥    Dim ak As String    ak = "你的百度地图API密钥"        ' 设置要搜索的地名    Str1 = "天安门"        ' 使用JavaScript进行URL编码    Set js = CreateObject("ScriptControl")    js.Language = "JScript"    Str2 = js.Eval("encodeURIComponent('" & Str1 & "')")        ' 构建请求URL    url = "http://api.map.baidu.com/place/v2/search?query=" & Str2 & "&region=全国&output=json&ak=" & ak & "&scope=2"        ' 发送HTTP请求    With CreateObject("MSXML2.XMLHTTP")        .Open "GET", url, False        .Send        responseText = .responseText    End With        ' 解析响应文本    Set html = CreateObject("htmlfile")    htmlString = responseText    html.write htmlString        ' 提取并显示结果    Dim results As Object    Set results = html.getElementById("results")        For i = 0 To results.length - 1        Debug.Print "名称: " & results.item(i).getAttribute("name")        Debug.Print "地址: " & results.item(i).getAttribute("address")        Debug.Print "电话: " & results.item(i).getAttribute("tel")        Debug.Print "----------------------"    Next iEnd Sub

• 运行VBA宏： 将上述代码复制到Excel的VBA编辑器中，并替换你的百度地图API密钥为你实际的API密钥。然后运行宏，它将搜索指定的地名，并在Immediate窗口中输出搜索结果。
  

请注意，这个示例代码是一个基础的起点，你可能需要根据你的具体需求进行调整和扩展。例如，你可以将搜索结果输出到Excel工作表中，而不是仅仅在Immediate窗口中显示。此外，由于百度地图API的限制，你可能需要处理分页和错误处理等问题。

ning84

越测试，越失望。


昆明老街 - 百度地图  https://map.baidu.com/search/%E6 ... 7/@11434079.7107069,2863171.53282925,18z?querytype=s&da_src=shareurl&wd=%E6%98%86%E6%98%8E%E8%80%81%E8%A1%97&c=140&src=0&pn=0&sug=0&l=19&b=(12640005.796341851,2524678.2936129;12640688.796341851,2524990.2936129)&from=webmap&biz_forward=%7B%22scaler%22:1,%22styles%22:%22pl%22%7D&device_ratio=1

结果是目标需求



结果不对了

Kaohsing

https://map.baidu.com/search/%E6 ... 7/@11437206.5148294,2829853.342289,19z?querytype=s&da_src=shareurl&wd=%E6%98%86%E6%98%8E%E5%8F%A4%E6%BB%87%E5%90%8D%E5%9F%8E%E7%9A%87%E5%86%A0%E5%81%87%E6%97%A5%E9%85%92%E5%BA%97&c=235&src=0&wd2=%E6%98%86%E6%98%8E&pn=0&sug=1&l=13&from=webmap&biz_forward=%7B%22scaler%22:1,%22styles%22:%22pl%22%7D&device_ratio=1




其中@11437206.5148294,2829853.342289,19z这个地址对应，类似于经纬度