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

API GEOLOCALIZACIÓN EN VBA

Uno de los post que tiene más visitas en Excel Signum es API MATRIZ DE DISTANCIAS, donde obtenemos el tiempo y la distancia a partir de un origen y un destino, realizando la petición de información a Google Maps.

Hace unos días, un lector me solicitó ayuda para conseguir los datos de geolocalización  de una serie de direcciones (latitud y longitud) y me pareció interesante para realizar una nueva entrada basada en esta consulta.

Antes de nada, comentar que existen varias alternativas para realizar este trabajo, todas ellas pasando por el API de Google Maps de geolocalización. Para este ejemplo usaré el API con formato de datos de salida jSON (en breve os mostraré otra versión con formato XML). Si queréis leer acerca del API y sus especificaciones, podáis hacerlo aquí: Google Maps Geocoding API

Utilizaremos un caso práctico para ilustrar el ejercicio, imaginad que hemos previsto realizar un pequeño viaje y queremos visitar: La Plaza Mayor (Chinchón), El Palacio Real (Aranjuez) y el Alcázar de Toledo. El punto de partida en el que hemos quedado es la Plaza de Santa Ana (Madrid), y queremos obtener las coordenadas de dichos lugares a partir de sus direcciones. Lo indicamos de la siguiente forma en nuestra hoja Excel:

api-geolocalizacion-en-vba

La idea es crear una función que capture el elemento de la columna B (Dirección) y nos devuelva en la columna C las coordenadas de latitud y longitud. Para ello vamos a utilizar 3 funciones. Una será la principal y las otras dos serán secundas pero muy importantes.

Antes de montar la función principal vamos a ver las otras, la primera es Carácter_e:

Private Function Caracter_e(ByVal Destino) As String
Dim i As Integer, fin As Integer
With Sheets(2)
fin = Application.CountA(.Range("A:A"))
'Aplicamos un bucle para sustituir caracteres especiales
For i = 1 To fin
Destino = Replace(Destino, .Cells(i, 1), .Cells(i, 2))
Next
Caracter_e = Destino
End With
End Function

Con esta función, a la hora de pasar los parámetros a Maps, convertimos aquellos caracteres especiales  (ejem: tildes, eñes, etc) que normalmente crear errores a caracteres válidos. Los parámetros los he puesto en la segunda hoja, (en caso de que necesitéis añadir alguno más solo tenéis que indicarlo como el resto):

api-geolocalizacion-en-vba1

La otra función que vamos a utilizar es aquella que extraerá de la cadena de datos solo los números, las comas, los puntos y los guiones.

Public Function Numeros(LatLong As String)
Dim i As Double, j As Double
Dim num As Variant
'extraemos números, comas, guiones y puntos de la cadena alfanumérica
With Sheets(1)
For i = Len(LatLong) To 1 Step -1
If IsNumeric(Mid(LatLong, i, 1)) Or Mid(LatLong, i, 1) = "," Or Mid(LatLong, i, 1) = "-" Or Mid(LatLong, i, 1) = "." Then
j = j + 1
num = Mid(LatLong, i, 1) & num
End If
If j = 1 Then num = (Mid(num, 1, 1))
Next i
Numeros = num
End With
End Function

Esta función (Numeros) es necesaria dado que cuando extraemos los datos mediante la función principal, en formato jSON, tendremos que extraer la información de Latitud y Longitud. Este es el formato de salida:

api-geolocalizacion-en-vba2

Ahora que ya hemos visto estas dos funciones os dejo la función principal Geocoding()

Function Geocoding(Destino As String) As String
Dim Consulta As String
Dim ObjetoXML As Object
Dim Peticion As String
Dim Marcador As Long
Dim sCadena As String
Dim LatLong As String
'Pasamos parámetros de la consulta y aplicamos función caracter_e
'por su tenemos caracteres especiales
Consulta = "http://maps.googleapis.com/maps/api/geocode/json?" _
& "&address=" & Caracter_e(Destino) & "&sensor=false"
'Enviamos la consulta y recibimos respuesta
Set ObjetoXML = CreateObject("Microsoft.XMLHTTP")
ObjetoXML.Open "GET", Consulta, False
ObjetoXML.send
Peticion = ObjetoXML.responseText
'extraemos los datos de latitud y longitud que necesitamos
'de la cadena que hemos obtenido
Marcador = InStr(1, Peticion, "location")
sCadena = Application.WorksheetFunction.Trim(Mid(Peticion, Marcador, 120))
'Para extraer las coordenadas usamos la función Números para que extraiga numeros, puntos, comas y guiones
LatLong = Numeros(Mid(sCadena, InStr(1, sCadena, "{"), (InStr(1, sCadena, "}") - InStr(1, sCadena, "{") + 1)))
'Obtenemos el resultado
Geocoding = LatLong
'Liberamos variable ObjetoXML
Set ObjetoXML = Nothing
End Function

Una vez que tenemos la cadena de texto, solo tendremos que realizar algunos ajustes para extraer los datos que necesitamos y que realizamos con diferentes funciones y recogeremos en las variables Marcador, sCadena y  LatLong

El resultado es el siguiente:

api-geolocalizacion-en-vba3

El botón que he colocado en la página es para visualizar mediante una sencilla macro la ruta que queremos realizar tomando como datos los códigos, está en el módulo2 de la hoja:

Sub Mapa()
Dim URL As String
With Sheets(1)
'Componemos la url para mostrar el mapa con la ruta.
URL = "https://www.google.com/maps/dir/" & .Range("C2") & "/" & .Range("C3") & "/" & .Range("C4") & "/" & .Range("C5")
ActiveWorkbook.FollowHyperlink URL, NewWindow:=False
End With
End Sub

Y la información que pasamos a maps nos muestra el siguiente mapa:

api-geolocalizacion-en-vba4

Como habéis podido comprobar, la información es correcta. He querido utilizar esta forma de extraer información de un archivo jSON para utilizar algunas de las funciones que hemos visto en el blog y demostrar así su utilidad (Números o Carácter_e).

Por último me gustaría recordaros que esta versión del API tiene una limitación diaria a 2.500 consultas. Lo podéis ver aquí: Límites de uso

En los próximos días os mostraré otra función pero trabajando con datos XML y utilizando otras variables y funciones para extraer la misma información.

Pues esto ha sido todo, como siempre os dejo el archivo:

Descarga el archivo de ejemplo pulsando en: API GEOLOCALIZACIÓN EN VBA