在 Excel 中
我尝试提取这个值“45.33887499999999”
通过此 Google 网址“https://maps.googleapis.com/maps/api/geocode/json?address=bojon”(在示例中 Google 网址 +"=bojon"或 +"=VENICE%20BEACH% 20CA”)
使用此 VBA 代码:
Public Function LATITUDE(coord As String)
Dim firstVal As String
firstVal = "https://maps.googleapis.com/maps/api/geocode/json?address="
Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
URL = firstVal & Replace(coord, " ", "+")
objHTTP.Open "GET", URL, False
objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
objHTTP.send ("")
If InStr(objHTTP.responseText, """location"" : {") = 0 Then GoTo ErrorHandl
Set regex = CreateObject("VBScript.RegExp"): regex.Pattern = """lat"".*?([0-9]+)": regex.Global = False
Set matches = regex.Execute(objHTTP.responseText)
tmpVal = Replace(matches(Index).SubMatches(0), ".", Application.International(xlListSeparator))
LATITUDE = CDbl(tmpVal)
Exit Function
ErrorHandl:
LATITUDE = -1
End Function
但此代码仅提取“45”,而不提取“45.33887499999999”
我尝试更改 regex.Pattern = """lat"".*?([0-9]+)"
但我还没有找到解决办法
最后,我想从此 URL 中提取具有 3 个不同公式(由 VBA 代码创建)的 3 个值
Google 网址 +“=bojon”
在这些行中
"formatted_address" : "30010 Bojon VE, Italia",
"geometry" : {
"location" : {
"lat" : 45.33887499999999,
"lng" : 12.06598
在 A1 单元格中:“bojon”
=GOOGDRESS(A1) 结果 =“30010 Bojon VE,意大利”
=纬度(A1) 结果 = "45.33887499999999"
=经度(A1) 结果 = "12.06598"
另一个例子:
Google 网址 +“=VENICE%20BEACH%20CA”
"formatted_address" : "Venice Beach, California, Stati Uniti",
"geometry" : {
"bounds" : {
"northeast" : {
"lat" : 33.996311,
"lng" : -118.4561299
},
"southwest" : {
"lat" : 33.9636437,
"lng" : -118.4835886
}
},
"location" : {
"lat" : 33.9936153,
"lng" : -118.4799099
=GOOGDRESS(A1) 结果 =“威尼斯海滩,加利福尼亚州,Stati Uniti”
=纬度(A1) 结果 = "33.9936153"
=经度(A1) 结果 = "-118.4799099"
谁能帮我吗?
最佳答案
使用脚本控件解析 JSON 并缓存 json 响应以避免不必要的 XMLHTTP 调用:
Sub Tester()
Debug.Print GetResult("https://maps.googleapis.com/maps/api/geocode/json?address=bojon", _
"results[0].geometry.location.lat")
Debug.Print GetResult("https://maps.googleapis.com/maps/api/geocode/json?address=bojon", _
"results[0].geometry.location.lng")
End Sub
Function GetResult(URL As String, jsonPath As String)
Static responseCache As Object
Dim objHTTP As Object, json As String
Dim sc As Object
If responseCache Is Nothing Then
Set responseCache = CreateObject("scripting.dictionary")
End If
If Not responseCache.exists(URL) Then
Debug.Print "Fetching:" & URL
Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
objHTTP.Open "GET", "https://maps.googleapis.com/maps/api/geocode/json?address=bojon", False
objHTTP.send ("")
json = objHTTP.responseText
responseCache.Add URL, json
Else
Debug.Print "Use cache:" & URL
json = responseCache(URL)
End If
Set sc = CreateObject("scriptcontrol")
sc.Language = "JScript"
sc.Eval "var obj=(" & json & ")" 'evaluate the json response
GetResult = sc.Eval("obj." & jsonPath)
End Function
关于json - Excel VBA 提取值 JSON URL,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/32868245/