获取Google Maps XML数据，进行解析并将其输入到Excel单元格中 [英] Get Google Maps XML data, parse it and input to Excel cells

问题描述

在Stackoverflow的帮助下，我设法获得了一个可行的解决方案，用于获取Google Maps XML数据，对其进行解析并将其输入到Excel单元格中.但是，当要分析5个不同的位置并将来自每个XML的数据输入到不同的单元格时，我的下一个意图是使它适用于多个请求.我能够通过5个不同的宏来做到这一点，然后像这样使用:

With help from Stackoverflow I managed to get a working solution for getting Google Maps XML data, parsing it and inputting to Excel cells. However my next intention get it working for several requests when there are 5 different locations to be analyzed and data from each XML should be inputted to different cells. I am able to do it by 5 different macros and then use like:

Sub Master()
   Call macro1
   Call macro2
   Call macro3
   Call macro4
   Call macro5
End Sub

我当时在想，也许我可以通过只编写一个宏并包含其中的所有宏来使代码更快.现在我坚持下去.也许只包含两个或三个目标变体，有人可以给我提示如何进行?

I was thinking maybe I can make code faster by making just one macro and including all in there. Now I stuck with it. Maybe by including just two or three destination variants somebody can give me a hint how to proceed?

我在工作表其他数据"上有数据(运行我的宏后，您可以看到第一个工作，由于某种原因，API密钥未完全显示):

I have data on Worksheet "Other Data" (you can see first one working after running my current macro, API key is not fully displayed for reason):

然后我试图使它们全部工作，但被卡住了.我使用DOMDocument30是因为我希望此代码也可以在Excel 2013中工作.这是我当前的宏:

Then I have tried to make them all work, but got stuck. I use DOMDocument30 because I would like this code to work in Excel 2013 as well. Here is my current macro:

Sub GoogleMapsAPIDurDist()
    Dim xmlhttp As Object
    Dim xmlhttp_1 As Object
    Dim xmlhttp_2 As Object
    Dim xmlhttp_3 As Object
    Dim xmlhttp_4 As Object
    Dim myurl As String
    Dim myurl_1 As String
    Dim myurl_2 As String
    Dim myurl_3 As String
    Dim myurl_4 As String
    Dim xmlDoc As DOMDocument30
    Dim xmlNode As IXMLDOMNode
    Dim sTemp As String
    Dim RE As Object, MC As Object
    Dim rDest As Range
    Dim APIkey As Range
    Dim TravelMode As Range

    Set xmlDoc = New DOMDocument30
    Set xmlhttp = CreateObject("MSXML2.serverXMLHTTP")
    Set APIkey = ThisWorkbook.Worksheets("Other Data").Range("CE1")
    Set TravelMode = ThisWorkbook.Worksheets("Other Data").Range("BY3")

    myurl = "https://maps.googleapis.com/maps/api/distancematrix/xml?origins=" & ThisWorkbook.Worksheets("Other Data").Range("BY1").Value _
    & "&destinations=" & ThisWorkbook.Worksheets("Other Data").Range("BY2").Value & "&mode=" & TravelMode & "&key=" & APIkey

    myurl_1 = "https://maps.googleapis.com/maps/api/distancematrix/xml?origins=" & ThisWorkbook.Worksheets("Other Data").Range("BY5").Value _
    & "&destinations=" & ThisWorkbook.Worksheets("Other Data").Range("BY6").Value & "&mode=" & TravelMode & "&key=" & APIkey

    myurl_2 = "https://maps.googleapis.com/maps/api/distancematrix/xml?origins=" & ThisWorkbook.Worksheets("Other Data").Range("BY9").Value _
    & "&destinations=" & ThisWorkbook.Worksheets("Other Data").Range("BY10").Value & "&mode=" & TravelMode & "&key=" & APIkey

    myurl_3 = "https://maps.googleapis.com/maps/api/distancematrix/xml?origins=" & ThisWorkbook.Worksheets("Other Data").Range("BY13").Value _
    & "&destinations=" & ThisWorkbook.Worksheets("Other Data").Range("BY14").Value & "&mode=" & TravelMode & "&key=" & APIkey

    myurl_4 = "https://maps.googleapis.com/maps/api/distancematrix/xml?origins=" & ThisWorkbook.Worksheets("Other Data").Range("BY17").Value _
    & "&destinations=" & ThisWorkbook.Worksheets("Other Data").Range("BY18").Value & "&mode=" & TravelMode & "&key=" & APIkey

    xmlhttp.Open "GET", myurl, False

    'xmlhttp.Open "GET", myurl_1, False

    'xmlhttp.Open "GET", myurl_2, False

    'xmlhttp.Open "GET", myurl_3, False

    'xmlhttp.Open "GET", myurl_4, False
    xmlhttp.send

    'hard coded here.  Change to suit
    Set rDest = ThisWorkbook.Worksheets("Other Data").Range("CA2")

    xmlDoc.LoadXML xmlhttp.responseText
    Set xmlNode = xmlDoc.SelectSingleNode("//duration/text")


    sTemp = xmlNode.Text

    Set RE = CreateObject("vbscript.regexp")
    With RE
        .Global = True
        .Pattern = "\d+"
        If .test(sTemp) = True Then
            Set MC = .Execute(sTemp)
            rDest(0, 1) = MC(0) & "," & MC(1)
        End If
    End With


    Set xmlNode = xmlDoc.SelectSingleNode("//distance/text")
    sTemp = xmlNode.Text
    With RE
        If .test(sTemp) = True Then
            Set MC = .Execute(sTemp)
            rDest(1, 1) = MC(0)
        End If
    End With

End Sub

推荐答案

使用Step计数器，每四个单元格区域范围简单地循环遍历Excel单元格.另外，避免使用With块重复长的ThisWorkbook.Worksheets("Other Data").

Simply loop over your Excel cells with Step counter for every four cell block ranges. Also avoid the need of repeating the long ThisWorkbook.Worksheets("Other Data") by using a With block.

此外，可能不需要您的正则表达式.一个简单的嵌套Replace()(取决于您的语言和距离单位，例如km与mi)可以正确引用CA列中的像元范围.最后，通过Dim和Set" rel ="nofollow noreferrer">早期绑定方法.当然也总是取消初始化Set对象.

Also, your regex might not be needed. A simple nested Replace() (depending your language and distance units, e.g., km vs mi) can work with correct reference to cell ranges in CA column. Finally, adjust Dim and Set by early-binding methods. Of course too always uninitialize Set objects.

Sub GoogleMapsAPIDurDist()
    Dim xmlhttp As New MSXML2.serverXMLHTTP, xmlDoc As New DOMDocument30
    Dim myurl As String, sTemp As String
    Dim APIkey As Range, TravelMode As Range
    Dim i as Long                                                ' NEW VARIABLE

    With ThisWorkbook.Worksheets("Other Data")
         Set APIkey = .Range("CE1")
         Set TravelMode = .Range("BY3")

         For i = 1 to 17 Step 4                                  ' LOOP WITH STEP    
              myurl = "https://maps.googleapis.com/maps/api/distancematrix/xml?" _
                       & "origins=" & .Range("BY" & i).Value  _
                       & "&destinations=" & .Range("BY" & i + 1).Value _
                       & "&mode=" & TravelMode & "&key=" & APIkey   

              xmlhttp.Open "GET", myurl, False
              xmlhttp.send
              xmlDoc.LoadXML xmlhttp.responseText

              sTemp = xmlDoc.SelectSingleNode("//duration/text").Text
              .Range("CA" & i) = Replace(Replace(sTemp, "days", ", "), "hours", "")

              sTemp = xmlDoc.SelectSingleNode("//distance/text").Text
              .Range("CA" & i + 1) = Replace(Replace(sTemp, " km", ""), " ", ",")
         Next i
    End With

    Set APIkey = Nothing: Set TravelMode = Nothing
    Set xmlhttp = Nothing: Set xmlDoc = Nothing
End Sub

这篇关于获取Google Maps XML数据，进行解析并将其输入到Excel单元格中的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！