Получите данные Google Maps XML, проанализируйте их и введите в ячейки Excel

Question

С помощью Stackoverflow мне удалось получить работающее решение для получения XML-данных Google Maps, их анализа и ввода в ячейки Excel.Однако мое следующее намерение заставить его работать для нескольких запросов, когда нужно проанализировать 5 разных мест и данные из каждого XML должны быть введены в разные ячейки.Я могу сделать это с помощью 5 различных макросов, а затем использовать как:

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

Я думал, может быть, я могу сделать код быстрее, сделав всего один макрос и включив все в нем.Теперь я застрял с этим.Может быть, включив всего два или три варианта назначения, кто-нибудь может дать мне подсказку, как действовать?

У меня есть данные на рабочем листе «Другие данные» (вы можете увидеть первый, работающий после запуска моего текущего макроса, ключ APIне полностью отображается по причине):

Затем я попытался заставить их все работать, но застрял.Я использую DOMDocument30, потому что я хотел бы, чтобы этот код работал и в Excel 2013.Вот мой текущий макрос:

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

Answer 1

Просто зациклите ваши ячейки Excel со счетчиком Step для каждых четырех диапазонов блоков ячеек.Также избегайте необходимости повторения длинного ThisWorkbook.Worksheets("Other Data") с помощью блока With.

Кроме того, ваше регулярное выражение может не понадобиться.Простой вложенный Replace() (в зависимости от вашего языка и единиц измерения расстояния, например, км против ми) может работать с правильной ссылкой на диапазоны ячеек в столбце CA.Наконец, настройте Dim и Set с помощью методов раннего связывания .Конечно, тоже всегда неинициализируйте Set объекты.

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