EXTRAER DATOS DE UNA CELDA Y COLOCARLOS EN DIAGONAL

Hola a todos : )

Este fin de semana he tenido que resolver dos consultas bastante complicadas que me enviaron unos lectores y no tuve tiempo para subir el post que había preparado. Pero hoy ya puedo hacerlo : )

La entrada de hoy se basa en una consulta que me enviaron hace unas semanas, aunque se trata de una tarea sencilla, realmente no sé cual es el destino o función para la que se necesita. En la petición se solicitaba una macro que extrajera el contenido de una celda (letras o números) y que colocase los datos en diagonal.

Intuyo que se trata de algo para generar claves o correspondencias, pero bueno … yo me he limitado a enviar el código según sus especificaciones.

Imaginad estos datos:

EXTRAER DATOS DE UNA CELDA Y COLOCARLOS EN DIAGONAL

y ahora tenemos que colocar cada letra o número de la palabra en diagonal, ¿cómo lo hacemos?, pues con esta macro:

Sub PASAR_A_DIAGONAL()
'Declaramos variables
Dim i As Long, j As Long
Dim fin As Long, n As Long
'Desactivamos actualización de pantalla
Application.ScreenUpdating = False
With Sheets("Hoja1")
'Eliminamos datos anteriores
If .Range("B2").Value <> vbNullString Then
.Range("B2", ActiveCell.SpecialCells(xlLastCell)).Select
Selection.ClearContents
End If
'Iniciamos loop que recorra todas las celdas
fin = Application.CountA(.Range("A:A"))
For i = 2 To fin
miCelda = .Cells(i, 1)
n = Application.CountA(.Range("B:B")) + 2
'Iniciamos loop que recorra toda la palabra
'y colocamos números o letras en diagonal
For j = 1 To Len(miCelda) Step 1
Letra = Mid(miCelda, j, 1)
.Cells(n, j + 1) = Letra
.Cells(n, j + 1).HorizontalAlignment = xlRight
n = n + 1
Next j
n = 0
Next i
.Range("A1").Select
Application.ScreenUpdating = True
End With
End Sub

Como podéis observar, básicamente utilizamos dos loop para localizar y extraer los datos. Luego solo tenemos que utilizar las variables creadas para indicar el lugar (horizontal y vertical) en que se debemos mostrar la información.

El resultado de aplicar la macro es este:

EXTRAER DATOS DE UNA CELDA Y COLOCARLOS EN DIAGONAL1

Efectivamente, los datos se han ordenado en diagonal, tanto las letras como los números. Sin duda una petición curiosa : )

Y esto ha sido todo por hoy, espero que os resulte interesante.

Descarga el archivo de ejemplo pulsando en: EXTRAER DATOS DE UNA CELDA Y COLOCARLOS EN DIAGONAL

 

 

¿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

GIRAR 180 GRADOS EL CONTENIDO DE UN RANGO SELECCIONADO EN EXCEL

Hola  a todos!.

Hace unos días un lector me enviaba una consulta acerca de la posibilidad de mostrar información en una celda en modo “imagen reflejada”, esto es, girar los caracteres de una palabra o frase 180 grados. La utilidad en estos casos suele ser para imprimir esa información y aplicarla en diferentes contextos, por ejemplo las ambulancias, que lo usan en el frontal del vehículo para que los conductores a los que necesita adelantar puedan leer que se trata de una ambulancia.

Si bien, para realizar esta tarea las impresoras suelen estar dotadas esta función, normalmente es necesario activarla en las características de la impresora o en el acabado de la hoja, etc …, en algunos casos o bien no existe esa posibilidad o bien la opción está desactivada por un administrador y no podemos realizar nuestro trabajo.

En Excel, se pueden girar los caracteres en una celda, pero el giro está limitado hasta los 90 grados, de forma que no lo podremos hacer directamente desde el menú. Pero existe una opción que sí nos permitiría girar los 180 grados, y es pasando el contenido de la celda a imagen y luego realizar el giro (en giro 3D):

GIRAR 180 GRADOS EL CONTENIDO DE UN RANGO SELECCIONADO EN EXCEL

Siguiendo con este método, podemos utilizar un poco de programación para que sea un poco más automático, de forma que solo tendremos que seleccionar el área o rango de celdas con la información y con tan solo pulsar un botón obtendremos los datos tal y como los necesitamos.

Imaginad que tenemos este texto y lo queremos mostrar reflejado:

GIRAR 180 GRADOS EL CONTENIDO DE UN RANGO SELECCIONADO EN EXCEL1

Para realizar esta tarea vamos a utilizar este código:

Sub GENERAR_IMAGEN_REFLEJADA()
'Definimos variables
Dim Area As Object
'Desactivamos actualización de pantalla
Application.ScreenUpdating = False
'Controlamos que existan datos en la selección
On Error GoTo Control
With ActiveSheet
Set Area = Application.Intersect(Selection, .UsedRange)
Area.Select
'Centramos horizontal y verticalmente el texto seleccionado
With Area
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
'Copiamos la selección y la pegamos en "C2"
Selection.Copy
.Range("C2").Select
.Pictures.Paste.Select
End With
'Rotamos la imagen 180 grados
With Selection
.ShapeRange.ThreeD.RotationX = -180
.Copy = False
End With
'Si no hemos seleccionado datos, mostramos mensaje de advertencia
Control: If Err.Number = "91" Then MsgBox ("EL RANGO SELECCIONADO NO CONTIENE DATOS"), vbExclamation, "SELECCIONA RANGO"
Application.ScreenUpdating = True
End Sub

Para este ejemplo he dejado un botón de comando para que probéis, pero también se podría modificar para ejecutarlo pulsando una tecla.

El resultado es el siguiente:

GIRAR 180 GRADOS EL CONTENIDO DE UN RANGO SELECCIONADO EN EXCEL2

Seleccionáis desde A2 a A3 y al pulsar el botón se generará la imagen reflejada automáticamente.

La imagen se pegará a partir de la celda “C2” (podéis especificar el lugar que más os convenga) y luego tan solo tendréis que establecer un área de impresión entorno a la imagen e imprimir.

Y eso es todo! 🙂

Descarga el archivo de ejemplo pulsando en: GIRAR 180 GRADOS EL CONTENIDO DE UN RANGO SELECCIONADO EN EXCEL

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

Donate Button with Credit Cards

¡¡Muchas gracias!!

USAR EXCEL PARA TRABAJAR CON BIG DATA

Hola a todos : ) Qué tal estáis?, seguro que bien!

Desde ya hace unos años, con el auge del denominado Big Data, y la necesidad de tratar enormes cantidades de información, han surgido multitud de plataformas, métodos y aplicaciones para gestionar esa ingente cantidad de datos (estamos hablando de billones de registros).

Excel y también Access, nos permiten trabajar con grandes bases de datos, pero cuando hablamos de Big Data, existen varias limitaciones que debemos tener muy en cuenta. En primer lugar, los límites de Excel en lo que a registros se refiere y en segundo lugar, tanto en Excel como en Access a la memoria disponible.

Es necesario reconocer las limitaciones de Excel. Es obvio que no podrá procesar la información de billones de registros en un tiempo razonable, simplemente no está programado para poder hacerlo. Pero esto no es motivo para pensar que Excel no puede trabajar en el mundo Big Data, siempre existe una alternativa, un método diferente que nos puede ayudar.

En el post de hoy os voy a demostrar cómo podemos trabajar con un archivo de texto de 1,41GB (contiene unos 7 millones de registros) y ser capaces de obtener información de su contenido. No voy a entrar hoy en técnicas de Data Mining, eso lo dejaré para una entrada posterior con los datos que consigamos extraer de la base de datos.

Lo más complicado para hacer pruebas con Big Data, es precisamente conseguir una base de datos aceptable y que sea de contenido público. Para este ejemplo he acudido a esta web DATA.GOV (es una web de política de datos abiertos donde además de multitud de bases de datos, también ofrecen información a nivel mundial de otras web con la misma política, es este enlace os podéis descargar la dirección de todas esas webs.

Pues bien, como necesitaba una buena base de datos, después de buscar bastante, decidí quedarme con esta: Crimes – 2001 to present, se trata de la relación de crímenes sucedidos en Chicago desde el año 2001 hasta la actualidad (nov de 2017):

USAR EXCEL PARA TRABAJAR CON BIG DATA

Elegí la descarga del archivo CSV y aunque sabía que no podría ver toda la información  porque supera el límite del 1.048.576 filas, sí me dejaría abrir el archivo para poder ver qué campos tenía y cuál era el delimitador que se usaba. Una vez finalizada la descargar y abierto el CSV esta es la información que aparecía:

USAR EXCEL PARA TRABAJAR CON BIG DATA1

Como podéis observar, en la primera línea de datos tenemos el nombre de los campos de nuestra base de datos y también sabemos que el delimitador utilizado es la coma “,” (si fuese otro tipo de delimitador sería necesario crear un archivo “schema.ini” indicando el carácter concreto).

Dado que no podemos importar toda esa información a nuestra hoja Excel (o en realidad sí, pero utilizando varias hojas, lo que haría bastante complicada nuestra explotación de datos posterior), lo más sencillo y efectivo es seleccionar aquellos campos que realmente nos interesan y traer esa información mediante una consulta (o varias).

Para este ejemplo, realmente ¿qué es lo que me interesa?, pues: El tipo de delito, la descripción del delito, el año en el que sucedió y el número de casos. Con estos parámetros obtendremos la información que queremos y será fácil de tratar dado que agruparemos por año y por tipo de delito.

Pues bien esto lo vamos a lograr con el siguiente código:

Sub EXCEL_BIG_DATA()
'Definimos variables
Dim cnn As Object, dataread As Object
Dim directorio As String, archivo As String
Dim encabezados As String, obSQL As String
Dim i As Long
'Creamos objetos ADO
Set cnn = CreateObject("ADODB.Connection")
Set dataread = CreateObject("ADODB.Recordset")
'Creamos variables para nombrar archivo y directorio
directorio = "D:\"
archivo = "Crimes_-_2001_to_present.csv"
'Componemos y abrimos la cadena de conexión
With cnn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = "DATA SOURCE=" & directorio
.Properties("Extended Properties") = "text;"" "
.Open
End With
'Componemos consulta SQL para extraer la información
obSQL = "SELECT `Primary Type` as `TIPO DE DELITO`, " & _
"Description as DESCRIPCION, YEAR(Date) as AÑO, count (`Primary Type`) as CASOS FROM [" & archivo & "] " & _
"WHERE Arrest like 'true' GROUP BY `Primary Type`, Description, YEAR (Date) "
'Guardamos resultado de la consulta en el recordset
With dataread
.Source = obSQL
.ActiveConnection = cnn
.CursorLocation = adUseClient
.CursorType = adOpenDinamic
.LockType = adLockOptimistic
.Open
End With
'Pasamos los datos del recordset a la hoja activa
With ThisWorkbook.Sheets("Hoja1")
.Cells(2, 1).CopyFromRecordset dataread
For i = 0 To dataread.Fields.Count - 1
encabezados = dataread.Fields(i).Name
.Cells(1, i + 1) = encabezados
Next
End With
'Liberamos memoria
Set cnn = Nothing
Set dataread = Nothing
End Sub

Como podéis observar estoy utilizando ADO para conectarme al archivo de texto y traerme los datos que he especificado en la consulta, de esta forma no tengo que importarme todo el archivo y solo aquello que necesito.

Aunque hemos creado los objetos conexión y recorset, es recomendable marcar la referencia Microsoft ActiveX Data Object 2.8 Library (o la que corresponda) para que todos los componentes funcionen correctamente, sobre todo .CursorLocation.LockType. Ya sabéis, las referencias las activáis en VBA aquí:

exportar-una-tabla-o-consulta-de-access-a-excel-con-ado2

Obviamente, en la variable “directorio” debemos especificar el directorio donde se encuentra el archivo CSV o TXT, (en este ejemplo lo tengo en la unidad “D”, en un pendrive) y en “archivo” es el nombre completo del archivo con la extensión incluida.

El resultado es el siguiente:

USAR EXCEL PARA TRABAJAR CON BIG DATA2

Después de casi un minuto la consulta nos devuelve la información que necesitamos. Es decir, ahora podemos trabajar en VBA y en Excel con datos de manera más efectiva y responder a preguntas como: ¿qué delitos han aumentado desde 2001 hasta 2017?, ¿cuáles han disminuido?, podríamos hacer un pronóstico en aquellos delitos más graves para años posteriores, podríamos conocer cuál es la droga que motiva más arrestos, etc, etc. En pocas palabras, podríamos tomar decisiones en base a datos fiables y cuantificables, pero esto lo haremos más adelante en otro post dedicado a Data Mining.

Realmente la importancia radica en todo el código, tanto en la configuración de la cadena de conexión, como en la composición de la consulta SQL, donde determinamos qué campos necesitamos y como queremos agruparlos, unirlos, etc.

Parece un proceso sencillo, pero es necesario escribir y pensar bien la sentencia SQL. En este ejemplo:

obSQL = "SELECT `Primary Type` as `TIPO DE DELITO`, " & _
"Description as DESCRIPCION, YEAR(Date) as AÑO, count (`Primary Type`) as CASOS FROM [" & archivo & "] " & _
"WHERE Arrest like 'true' GROUP BY `Primary Type`, Description, YEAR (Date) "

Seleccionamos el tipo de delito primario, la descripción( por ejemplo, en detenciones por narcóticos, aquellos que son por heroína, metanfetamina, etc), el año y contamos por el campo tipo de delito (en esta consulta que el campo Arrest sea igual a “true” y finalmente agrupamos por tipo de delito y por el año en el que se ha cometido.

El uso de las comillas invertidas ” ` ” se debe a que algunos nombres de campo tiene espacios en blanco y eso genera errores en SQL, para solventarlo, usamos las comillas invertidas.

La consulta podría ser mucho más compleja y extensa, pero para realizar este ejemplo creo que es suficiente, el objetivo es demostrar que se puede trabajar con una base de datos de “gigas” y superando los límites de Excel con tiempos razonables. No necesitamos importar el archivo a Excel, simplemente lanzamos consultas desde Excel y obtenemos el resultado, evitando problemas de espacio y eficiencia.

La idea es, “si es demasiado grande, trabaja con dimensiones más pequeñas”.

Esta técnica tiene sus límites en la capacidad de memoria que tenga nuestro equipo, pero es de mucha utilidad para establecer procesos automáticos donde debemos extraer y analizar información.

No subiré el archivo CSV, lo podéis descargar en el enlace que os dejé al principio. En cuando a la macro, debéis especificar el directorio en el que hayáis guardado el archivo para que funcione correctamente y el nombre del archivo.

Los tiempos con los que obtendréis los datos van a variar según el equipo con el que trabajéis (memoria disponible, procesador, etc), en este ejemplo he utilizado mi portátil, pero con el equipo de sobremesa ha sido mucho más veloz.

Os dejo el archivo con la macro, con las referencias marcadas y preparado para realizar el ejemplo:

Descarga el archivo de ejemplo pulsando en: USAR EXCEL PARA TRABAJAR CON BIG DATA

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

Donate Button with Credit Cards

¡¡Muchas gracias!!

ELIMINAR DUPLICADOS EN UNA CADENA DE TEXTO Y ORDENAR INFORMACIÓN

Hola de nuevo a todos:

Llevo varios post tratando la eliminación de elementos duplicados, en los ejemplos anteriores buscamos la forma de hacerlo en un rango de celdas y aprovechamos también para introducir un proceso que nos ordenase los datos en caso de ser necesario (por ejemplo en un cuadro de lista o un cuadro combinado).

Pues bien, han sido varias las peticiones para que aplicase el mismo método pero para eliminar duplicados en una cadena de texto (string). O lo que es lo mismo, en la información contenida en una celda.

Pues bien, para contestar a estas dudas y cerrar por ahora esta temática os voy a dejar tres funciones personalizadas (UDF) que hacen precisamente lo que se pide, es decir lograremos conservar solo los elementos únicos en una cadena de texto. Adicionalemente os dejaré también otra función con los elementos necesarios para ordenar el texto final.

En primer lugar, hay que tener en cuenta que una cadena de texto puede estar delimitada por multitud de caracteres, siendo los más habituales: la coma “,” el punto y coma “;” el punto “.” y finalmente el espacio en blanco ” “.

Vamos a comenzar con la función para extraer únicos en una cadena de texto delimitada por espacios en blanco:

Function UNICOS(ByVal Micelda As String)
'Declaramos las variables
Dim oDic As Object, palabra As Variant
Dim ipalabra As String, matriz As Variant
Dim sCadena As String, i As Long
'Trabajamos con la hoja
With ActiveSheet
Set oDic = CreateObject("scripting.dictionary")
'Por cada celda con datos en el rango rango componemos un string
For Each palabra In Split(Micelda, " ")
ipalabra = ipalabra & " " & palabra
Next palabra
'Eliminamos posibles espacios en blanco
sCadena = Trim(ipalabra)
'Comprobamos que cada palabra que incluimos en la matriz no existe en la cadena
matriz = Split(sCadena, " ")
For i = 0 To UBound(matriz)
If Not oDic.Exists(matriz(i)) Then oDic.Add matriz(i), matriz(i)
Next i
'Creamos una nueva cadena sin duplicados
UNICOS = Join(oDic.Keys, " ")
'Liberamos memoria
Set oDic = Nothing
End With
End Function

Si la aplicamos en un sencillo ejemplo con nombres de animales o de comunidades autónomas y ciudades, este sería el resultado.

ELIMINAR DUPLICADOS EN UNA CADENA DE TEXTO Y ORDENAR INFORMACION

Ahora sería interesante realizar el mismo planteamiento pero con delimitadores diferentes al espacio en blanco, por ejemplo una coma:

Function UNICOS_DELIMITADOR(ByVal Micelda As String)
'Declaramos las variables
Dim oDic As Object, palabra As Variant
Dim ipalabra As String, matriz As Variant
Dim sCadena As String, i As Long
'Trabajamos con la hoja
With ActiveSheet
Set oDic = CreateObject("scripting.dictionary")
'Por cada celda con datos en el rango rango componemos un string
For Each palabra In Split(Micelda, ", ")
ipalabra = ipalabra & ", " & palabra
Next palabra
'Eliminamos posibles espacios en blanco
sCadena = Trim(Mid(ipalabra, 2, Len(ipalabra)))
'Comprobamos que cada palabra que incluimos en la matriz no existe en la cadena
matriz = Split(sCadena, ", ")
For i = 0 To UBound(matriz)
If Not oDic.Exists(matriz(i)) Then oDic.Add matriz(i), matriz(i)
Next i
'Creamos una nueva cadena sin duplicados
UNICOS_DELIMITADOR = Join(oDic.Keys, ", ")
'Liberamos memoria
Set oDic = Nothing
End With
End Function

Sobra decir, que si tenéis otro delimitador, solo tenéis que sustituirlo donde aparece la coma “, ” por otro.

Siguiendo el ejemplo anterior, este sería el resultado:

ELIMINAR DUPLICADOS EN UNA CADENA DE TEXTO Y ORDENAR INFORMACION1

Y por último, partiendo del mismo delimitador, vamos a incluir la posibilidad de ordenar la cadena de texto, utilizaremos esta función:

Function UNICOS_DELIMITADOR_ORDENADO(ByVal Micelda As String)
'Declaramos las variables
Dim oDic As Object, palabra As Variant, npalabra As String
Dim ipalabra As String, matriz As Variant, matriz1 As Variant
Dim sCadena As String, sCadena1 As String, i As Long, alfadato As Variant
'Trabajamos con la hoja
With ActiveSheet
Set oDic = CreateObject("scripting.dictionary")
'Por cada celda con datos en el rango rango componemos un string
For Each palabra In Split(Micelda, ", ")
ipalabra = ipalabra & ", " & palabra
Next palabra
'Eliminamos la primera coma del string
sCadena = Mid(ipalabra, 2, Len(ipalabra))
Set matriz = CreateObject("System.Collections.ArrayList")
'Y ordenamos las palabras
For Each palabra In Split(sCadena, ",")
matriz.Add palabra
Next palabra
matriz.Sort
'Pasamos de nuevo las palabras ordenadas a un string
For Each alfadato In matriz
npalabra = npalabra & "," & alfadato
Next alfadato
sCadena1 = Trim(Mid(npalabra, 2, Len(npalabra)))
'Comprobamos que cada palabra que incluimos en la matriz no existe en la cadena
matriz1 = Split(sCadena1, ", ")
For i = 0 To UBound(matriz1)
If Not oDic.Exists(matriz1(i)) Then oDic.Add matriz1(i), matriz1(i)
Next i
'Creamos una nueva cadena ordenada y sin duplicados
UNICOS_DELIMITADOR_ORDENADO = Join(oDic.Keys, ", ")
'Liberamos memoria
Set oDic = Nothing
Set matriz = Nothing

End With
End Function

Simplemente pasamos los datos por una matriz y los ordenamos. El resultado es este:

ELIMINAR DUPLICADOS EN UNA CADENA DE TEXTO Y ORDENAR INFORMACION2

Y con estas sencillas funciones tenemos bastante comentado el tema de los registros duplicados y su tratamiento, y también la posibilidad de ordenar esos datos alfabéticamente.

Es importante tener muy en cuenta los espacios en blanco, incluso el que se deja delante de la coma antes de escribir la palabra siguiente. Por eso, si tenéis espacios en blanco únicamente utilizar la primera función, si existen comas, puntos, etc, la segunda función será la más adecuada.

Es fundamental saber tratar este tipo de necesidades en cadenas de texto, pensad que al fin y al cabo es información que vais a pasar a multitud de plataformas, herramientas, etc.

Pues eso es todo, espero que os sea de utilidad.

Descarga el archivo de ejemplo pulsando en: ELIMINAR DUPLICADOS EN UNA CADENA DE TEXTO Y ORDENAR INFORMACIÓN

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


Donate Button with Credit Cards

¡¡Muchas gracias!!

ELIMINAR REGISTROS DUPLICADOS Y ORDENAR ALFABÉTICAMENTE LA INFORMACIÓN

Hola a todos:

En el post anterior hemos visto una nueva técnica para obtener registros únicos usando el objeto “Diccionario”: ELIMINAR REGISTROS DUPLICADOS Y CARGAR DATOS ÚNICOS EN COMBOBOX Y LISTBOX

Entre las consultas que me enviaron los lectores, una de ellas era sobre si se podían ordenar esos datos una vez eliminados los duplicados y pasar esa información al combobox y al listbox. Como me pareció útil e interesante, he decidido crear un nuevo post como continuación al anterior (de esta forma se verá más claro).

Partiendo de una información diferente, no meses, sino por nombre de personas:

ELIMINAR REGISTROS DUPLICADOS Y ORDENAR ALFABETICAMENTE LA INFORMACION

Vamos a hacer el mismo ejercicio que en post anterior, es decir, eliminar duplicados, ordenar la información y pasar los datos a un combobox y a un listbox:

Sub CARGAR_UNICOS_ORDENADOS()
'Declaramos las variables
Dim rango As Range, celda As Object, oDic As Object, npalabra As String
Dim sCadena As String, sCadena1 As String, ipalabra As String, OrdenarAlfa As Variant
Dim matriz As Variant, matriz1 As Variant, palabra As Variant, alfadato As Variant
Dim i As Long, j As Long, fin As Integer
'Trabajamos con la hoja
With Sheets("UNICOS")
'Limpiamos combo y listbox
.ComboBox1.Clear
.ListBox1.Clear
'Definimos el rango de los datos
fin = .Range("A" & Rows.Count).End(xlUp).Row
'Trabajamos con rango establecido
Set rango = .Range("A2:A" & fin)
'Por cada celda del rango componemos un string
For Each celda In rango
If celda <> vbNullString Then
ipalabra = ipalabra & "," & celda
End If
Next celda
'Eliminamos posibles espacios en blanco
sCadena = Trim(Mid(ipalabra, 2, Len(ipalabra)))
'Comprobamos que cada palabra que incluimos en la matriz no existe en cadena
matriz = Split(sCadena, ",")
Set oDic = CreateObject("scripting.dictionary")
For i = 0 To UBound(matriz)
If Not oDic.Exists(matriz(i)) Then oDic.Add matriz(i), matriz(i)
Next i
'Creamos una nueva cadena ya sin duplicados
sCadena1 = Join(oDic.Keys, ",")
'Pasamos los datos a una matriz
Set matriz1 = CreateObject("System.Collections.ArrayList")
'Y ordenamos las palabras
For Each palabra In Split(sCadena1, ",")
matriz1.Add palabra
Next palabra
matriz1.Sort
'Pasamos de nuevo las palabras ordenadas a un string
For Each alfadato In matriz1
npalabra = npalabra & "," & alfadato
Next alfadato
OrdenarAlfa = Split(Trim(Mid(npalabra, 2, Len(npalabra))), ",")
'Pasamos los datos al Combo y al listbox
For j = 0 To UBound(OrdenarAlfa)
.ComboBox1.AddItem (OrdenarAlfa(j))
.ListBox1.AddItem (OrdenarAlfa(j))
Next
'Limpiamos variable de objeto
Set rango = Nothing
Set oDic = Nothing
End With
End Sub

Si vais observando la construcción de la macro, podéis ver que hemos incluido un pequeño subproceso en el código a través del cual volvemos a pasar los datos del rango a una matriz y los ordenamos con la propiedad “.sort”.

El resto del código es igual que el ejemplo anterior, y para que veáis cómo funciona, os dejo el resultado:

ELIMINAR REGISTROS DUPLICADOS Y ORDENAR ALFABETICAMENTE LA INFORMACION1

Como podéis observar, hemos conseguir el objetivo propuesto, los datos se han cargado sin duplicados y se han ordenado alfabéticamente.

Descarga el archivo de ejemplo pulsando en: ELIMINAR REGISTROS DUPLICADOS Y ORDENAR ALFABÉTICAMENTE LA INFORMACIÓN

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

Donate Button with Credit Cards

¡¡Muchas gracias!!

ELIMINAR REGISTROS DUPLICADOS Y CARGAR DATOS ÚNICOS EN COMBOBOX Y LISTBOX

Hola a todos!

El universo de los datos duplicados y su tratamiento es muy variado en Excel, se pueden tratar tanto con fórmulas, con comandos instalados en la hoja y también con vba. El objetivo suele ser siempre trabajar con registros únicos para evitar duplicidades en las informaciones.

En esta web hay varios ejemplos de cómo se pueden obtener registros únicos, hoy os voy a mostrar una nueva variante. Imaginad que tenéis los meses del año en una columna, pero en algunos casos se duplica el nombre de los meses:

ELIMINAR REGISTROS DUPLICADOS Y CARGAR DATOS UNICOS EN COMBOBOX Y LISTBOX

El objetivo será obtener registros únicos y cargar un combobox y un listbox. Para ello vamos a trabajar con la siguiente macro:

Sub CARGAR_UNICOS()
'Declaramos las variables
Dim rango As Range, oDic As Object, celda As Object
Dim ipalabra As String, matriz1 As Variant, matriz2 As Variant
Dim sCadena1 As String, sCadena2 As String, i As Long, j As Long, Fin As Integer
'Trabajamos con la hoja
With Sheets("UNICOS")
'Limpiamos combo y listbox
.ComboBox1.Clear
.ListBox1.Clear
'Definimos el rango de los datos
Fin = .Range("A" & Rows.Count).End(xlUp).Row
'Trabajamos con rango establecido y creamos objeto diccionario
Set rango = .Range("A2:A" & Fin)
Set oDic = CreateObject("scripting.dictionary")
'Por cada celda con datos en el rango rango componemos un string
For Each celda In rango
If celda <> vbNullString Then
ipalabra = ipalabra & "," & celda
End If
Next celda
'Eliminamos posibles espacios en blanco
sCadena1 = Trim(Mid(ipalabra, 2, Len(ipalabra)))
'Comprobamos que cada palabra que incluimos en la matriz no existe en cadena
matriz1 = Split(sCadena1, ",")
For i = 0 To UBound(matriz1)
If Not oDic.Exists(matriz1(i)) Then oDic.Add matriz1(i), matriz1(i)
Next i
'Creamos una nueva cadena ya sin duplicados
sCadena2 = Join(oDic.Keys, ",")
matriz2 = Split(Trim(sCadena2), ",")
'Pasamos los datos al Combo y al listbox
For j = 0 To UBound(matriz2)
.ComboBox1.AddItem (matriz2(j))
.ListBox1.AddItem (matriz2(j))
Next
'Liberamos memoria
Set rango = Nothing
Set oDic = Nothing
End With
End Sub

Lo que estamos haciendo con este código es: pasar los datos del rango a una variable string con todos los meses (incluidos los repetidos) en una cadena de texto. Si en ese rango existen celdas sin información, no las tendremos en cuenta.

Con el objeto “scripting.dictionary” y mediante un loop, comprobamos si cada palabra “no” existe, en caso afirmativo, la incorporamos de nuevo a la “matriz1”. De esta forma controlamos que no aparezcan registros duplicados en nuestros datos.

A continuación, pasamos los datos a una string y de nuevo a una matriz (matriz2), que nos permitirá con un loop cargar los datos en el Combobox1 y en el Listbox1.

En las partes del código donde hago mención al uso de la coma como delimitador “,” es necesario su utilización para delimitar los elementos de la celda. Si usásemos un espacio en blanco pasaría la segunda, tercera o n palabra como si fuesen otra celda (que puede que también os sea de utilidad para obtener únicos en una única celda).

El resultado es el siguiente:

ELIMINAR REGISTROS DUPLICADOS Y CARGAR DATOS UNICOS EN COMBOBOX Y LISTBOX1

Como podéis observar, los datos se han cargado correctamente y sin duplicados. Por cierto, para que realicéis pruebas he adjuntado una sencilla macro para vaciar el combobox y el listbox que está vinculada al botón “Vaciar Combo y Listbox”.

Y eso es todo, espero que este método os resulte de interés : )

Descarga el archivo de ejemplo pulsando en: ELIMINAR REGISTROS DUPLICADOS Y CARGAR DATOS UNICOS EN COMBOBOX Y LISTBOX

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

Donate Button with Credit Cards

¡¡Muchas gracias!!

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!!