Excel VBA提取值JSON URL
在Excel中
我试图提取这个值“45.33887499999999”
通过此Googleurl“ https://maps.googleapis.com/maps/api/geocode/json?address=bojon ” (例如Google URL + “= 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] +)”
但我还没有find解决办法
最后,我想从这个URL中提取3个不同的公式(由VBA代码创build)的值
Googleurl+“= bojon”
在这些行中
"formatted_address" : "30010 Bojon VE, Italia", "geometry" : { "location" : { "lat" : 45.33887499999999, "lng" : 12.06598
在A1单元格中:“bojon”
= GOOGDRESS(A1)结果=“30010 Bojon VE,意大利”
= LATITUDE(A1)结果=“45.33887499999999”
= LONGITUDE(A1)结果=“12.06598”
另一个例子:
Googleurl+“= 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”
= LATITUDE(A1)结果=“33.9936153”
= LONGITUDE(A1)结果=“-118.4799099”
谁能帮我?
使用脚本控件parsingJSON并cachingjson响应,以避免不必要的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
试试这个模式: """lat""(\s)*:(\s)*(\d)+(.(\d)+)?"
要分解它,
- “”lat“”匹配string
- (\ s)*匹配任何可能位于令牌之间的空格
- :是字面的
- (\ s)*再次匹配空格
- (\ d)+匹配一些数字
- ((\ d)+)? 可选地匹配小数点后跟一串数字(至less一个)
在这个例子中,我把其他两个作为一个练习给你,但是如果你有麻烦,让我知道!