ACTUALIZACIÓN API MATRIZ DE DISTANCIAS

Hola a todos!

Hace tiempo que tenía pendiente realizar una actualización del post: API MATRIZ DE DISTANCIAS EN VBA.

Y los motivos de realizar dichos cambios se deben por una parte a la necesidad de actualizar su programación y por otra a las limitaciones actuales de trabajar con matrices para poder obtener los datos de distancia y tiempo.

No obstante, el post anterior funciona correctamente y se puede utilizar sin problema.

Dado que no solo quería limitarme crear dos funciones independientes, una para obtener el tiempo y otra para obtener la distancia entre dos puntos, también he mejorado la programación. Podemos comenzar con la primera, la función DURACION_RUTA:

Function DURACION_RUTA(Origen, Destino)
'Declaramos las variables a utilizar
Dim Url As String
Dim Consulta As String
Dim Peticion As Object
Dim Respuesta As Object
Dim iNodos As Object
'Aplicamos conversion de caracteres especiales (con la función Caracter_e) al Origen y Destino
Origen = Caracter_e(LCase(Origen))
Destino = Caracter_e(LCase(Destino))
'Componemos la url necesaria para realizar la petición de datos como una matriz
Url = "https://maps.googleapis.com/maps/api/distancematrix/xml?origins=" & Origen & "&destinations=" & Destino _
& "&mode=" ' por defecto la ruta es en coche, el resto de opciones serían:
'"mode=bicycling"- en bicicleta
'"mode=walking"- andando
Set Peticion = CreateObject("Microsoft.XMLHTTP")
Set Respuesta = CreateObject("Msxml2.DOMDocument.6.0")
Set iNodos = Respuesta.createNode(1, "xml", "")
'Realizamos la consulta
Peticion.Open "GET", Url, False
Peticion.send
Respuesta.LoadXML (Peticion.responseText)
Set iNodos = Respuesta.getElementsByTagName("duration")
'Extraemos la duración del viaje y le damos formato
DURACION_RUTA = Format(Trim(Mid(iNodos(0).Text, 1, InStr(iNodos(0).Text, " "))) / 86400, "h:mm ""h""")
'Liberamos memoria
Set Peticion = Nothing
Set Respuesta = Nothing
Set iNodos = Nothing
End Function

Y ahora con la función DISTANCIA_RUTA:

Function DISTANCIA_RUTA(Origen, Destino)
'Declaramos las variables a utilizar
Dim Url As String
Dim Consulta As String
Dim Peticion As Object
Dim Respuesta As Object
Dim iNodos As Object
'Aplicamos conversion de caracteres especiales (con la función Caracter_e) al Origen y Destino
Origen = Caracter_e(LCase(Origen))
Destino = Caracter_e(LCase(Destino))
'Componemos la url necesaria para realizar la petición de datos como una matriz
Url = "https://maps.googleapis.com/maps/api/distancematrix/xml?origins=" & Origen & "&destinations=" & Destino _
& "&mode=" ' por defecto la ruta es en coche, el resto de opciones serían:
'"mode=bicycling"- en bicicleta
'"mode=walking"- andando
Set Peticion = CreateObject("Microsoft.XMLHTTP")
Set Respuesta = CreateObject("Msxml2.DOMDocument.6.0")
Set iNodos = Respuesta.createNode(1, "xml", "")
'Realizamos la consulta
Peticion.Open "GET", Url, False
Peticion.send
Respuesta.LoadXML (Peticion.responseText)
Set iNodos = Respuesta.getElementsByTagName("distance")
'Extraemos la distancia y le damos formato
DISTANCIA_RUTA = Format(Trim(Mid(iNodos(0).Text, 1, InStr(iNodos(0).Text, " "))) / 1000, "#,##0.00 ""Km""")
'Liberamos memoria
Set Peticion = Nothing
Set Respuesta = Nothing
Set iNodos = Nothing
End Function

Como podéis observar, con estas nuevas funciones podemos obtener los datos de manera independiente, no es necesario introducir el resultado en una matriz ni mostrar los dos datos en conjunto. Además con la nueva programación trabajamos sobre la salida de datos en XML y también damos formato a la información sin necesidad de hacerlo en la hoja.

Por otra parte, en el post anterior, había escrito una función para tratar los caracteres especiales, como la ñ o las tildes. El inconveniente era que esos caracteres se tenían que escribir en varias celdas para ser consultadas por la función, lo que supone un problema si esas celdas se eliminan o la información se pasa a otra parte de la hoja (dejaría de funcionar todo). Pues bien, también he mejorado esta función:

Function Caracter_e(ByVal Cadena As String) As String
'Declaramos variables
Dim sDato As String
Dim sCadena As Long
Dim Contador As Long
Dim nItem As String
'Si encontramos un caracter especial, lo sustituimos
sCadena = Len(Cadena)
If sCadena > 0 Then
For Contador = 1 To sCadena
nItem = Mid$(Cadena, Contador, 1)
Select Case nItem
Case "Ñ"
nItem = "N"
Case "ñ"
nItem = "n"
Case "á"
nItem = "a"
Case "é"
nItem = "e"
Case "í"
nItem = "i"
Case "ó"
nItem = "o"
Case "ú"
nItem = "u"
Case "ç"
nItem = "c"
End Select
sDato = sDato & nItem
Next Contador
End If
Caracter_e = sDato
End Function

Efectivamente, lo solucionamos con un sencillo “Select Case”. Ahora la función está incorporada dentro del código sin necesidad de escribir información en la hoja.

El resultado es el siguiente:

ACTUALIZACION API MATRIZ DE DISTANCIAS

Las dos funciones generan y muestran la información correctamente. Podemos colocarlas en el lugar que queramos y sin necesidad de dar formato, el código lo hace directamente.

Y por último, en el post anterior, también había incluido una sencilla macro para generar el mapa de los datos que habíamos indicado en la hoja. Esta macro componía una url que se ejecutaba y mostraba la ruta indicada en las celdas. El inconveniente que tenía era que la referencia a las celdas estaba escrita en el código, de forma que si era necesario aumentar o reducir el número de celdas, era necesario modificar la macro.

Pues bien, finalmente la he programado para que solo sea necesario seleccionar las celdas con los datos de origen y destino, sea un rango o celdas independientes y pulsar el botón de comando que existe en la hoja y se mostrará el mapa con la ruta.

Esta es la función:

Sub MAPA()
'Declaramos las variables
Dim Matriz As Object, Palabra As Variant, Area As Object
Dim alfaDato As Variant, iPalabra As String
'Creamos colección arraylist para ir agregando los elementos de la matriz
Set Matriz = CreateObject("System.Collections.ArrayList")
'Trabajamos con la hoja activa
With ActiveSheet
Set Area = Application.Intersect(Selection, .UsedRange)
'Controlamos que existan datos seleccionados
On Error GoTo Control
'Por cada objeto/palabra del rango seleccionado
For Each Palabra In Area
'Añadimos cada palabra a la matriz con un loop
Matriz.Add Palabra
Next Palabra
'Pasamos los datos a una cadena de texto
For Each alfaDato In Matriz
iPalabra = iPalabra & "/" & alfaDato
Next alfaDato
OrdenarAlfa = Trim(iPalabra)
'Abrimos explorador y mostramos la ruta
Url = "https://www.google.com/maps/dir" & OrdenarAlfa
ActiveWorkbook.FollowHyperlink Url, NewWindow:=False
'mostramos mensaje de error
Control: If Err.Number = "424" Then
MsgBox ("EL RANGO O LAS CELDAS SELECCIONADAS NO CONTIENEN DATOS"), vbExclamation, "SIN DATOS SELECCIONADOS"
End If
'Limpiamos variable de objeto
Set Matriz = Nothing
Set Area = Nothing
End With
End Sub

Y este es el resultado después de seleccionar y pulsar el botón:

ACTUALIZACION API MATRIZ DE DISTANCIAS1

Y con esto finalizamos el post de hoy, espero que este post os sea de utilidad.

Descarga el archivo de ejemplo pulsando en: ACTUALIZACIÓN API MATRIZ DE DISTANCIAS

 

¿Te ha resultado de interés?, puedes apoyar a Excel Signum con una pequeña donación.

Donate Button with Credit Cards

¡¡Muchas gracias!!

Anuncios

14 pensamientos en “ACTUALIZACIÓN API MATRIZ DE DISTANCIAS

  1. Pingback: API MATRIZ DE DISTANCIAS EN VBA | EXCEL SIGNUM

    • Gracias Salvador! Me alegro que te guste el post!.

      Sobre lo del tiempo total entre todas las rutas, sería necesario reprogramar el API, pasando un rango por los parámetros de origen y destino (algo parecido a lo que hago en la última función). Me parece interesante tu comentario, así que investigaré esa petición y cuando tenga un resultado te lo informaré.

      Muchas gracias 🙂

      Me gusta

    • Hola María:

      Para insertar el navegador es necesario hacerlo con un webbrowser en un formulario. Pero es problemático, en primer lugar por los errores de script y por otro la versión del navegador embebida en ese webbrowser normalmente no se corresponde con la última versión del navegador instalado en tu equipo, lo que origina problemas de compatibilidad e impide mostrar correctamente el mapa. La solución pasa por modificar el registro de windows (y eso implica riesgos en el equipo), por eso he optado por mostrar directamente el mapa en el navegador invocándolo desde Excel.

      Sobre esta problemática tienes bastantes ejemplos de usuarios quejándose en foros y webs.

      En resumen, dado los riesgos que puede generar el realizar cambios en el registro de windows, es muy recomendable utilizar el navegar que tengas instalado y usar internet.

      Un saludo.

      Me gusta

  2. Hola Segu, tengo una pregunta con respecto a la parte del código que calcula el tiempo y las distancias, como lo puedo modificar para que funcione en las hojas de calculo de google drive?, gracias por compartir es genial el trabajo!

    Me gusta

    • Hola María, en google drive las macros se denominan Google Apps Scripts. Y aunque tiene parecido, no es igual que VBA. Se tendría que programar la función en ese lenguaje para que te funcionase. Pero eso ya no es materia de esta web, donde los ejemplos se basan en Excel con microsoft.

      Saludos!!

      Me gusta

¿Te ha gustado?. Deja un comentario

Introduce tus datos o haz clic en un icono para iniciar sesión:

Logo de WordPress.com

Estás comentando usando tu cuenta de WordPress.com. Cerrar sesión / Cambiar )

Imagen de Twitter

Estás comentando usando tu cuenta de Twitter. Cerrar sesión / Cambiar )

Foto de Facebook

Estás comentando usando tu cuenta de Facebook. Cerrar sesión / Cambiar )

Google+ photo

Estás comentando usando tu cuenta de Google+. Cerrar sesión / Cambiar )

Conectando a %s