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

Anuncios

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

COMBOBOX DEPENDIENTES EN USERFORM CON SQL

ISuele ser una consulta recurrente en Excel el tema de los combobox dependientes, y es que para algunas aplicaciones o proyectos donde el usuario ha de seleccionar ciertos ítems con dependencia entre ellos, el uso de los combos dependientes es realmente útil.

Se pueden realizar combos dependientes de diversas formas, pero siempre vamos a tener que usar VBA, (al contrario de Access, donde esta posibilidad está incluida en los formularios). Esta vez, además de hacerlo a través de VBA vamos a implementar el ejercicio con ADO y SQL para obtener el mismo resultado.

Este ejemplo voy a realizarlo en un userform, pero también os dejaré el ejemplo en una hoja Excel. Los que leéis esta web habitualmente ya sabéis que si vamos a usar ADO, debemos habilitar en nuestro editor VBA las siguientes referencias:

COMBOBOX DEPENDIENTES EN USERFORM CON SQL

Ahora ya podemos comenzar con el post. Utilizaremos para este ejemplo la base de datos habitual de los grandes almacenes, pero utilizamos los siguientes campos:

COMBOBOX DEPENDIENTES EN USERFORM CON SQL1

Una vez que tenemos estos datos y los campos que vamos a mostrar en los combos (en este caso serán 4), ya podemos ir a VBA e insertar los combobox:

COMBOBOX DEPENDIENTES EN USERFORM CON SQL2

Teniendo en cuenta que el userform lo he denominado “DEPENDIENTES”, debéis pegar en código del userform, la siguiente macro:

Private Sub UserForm_Initialize()
Dim Dataread As ADODB.Recordset, sSQL As String, cnn As ADODB.Connection
'Llamamos a función Abre_Cnn para conectarnos con la base de datos
Set cnn = Abre_Cnn
With DEPENDIENTES
'Realizamos consulta sql para seleccionar con datos agrupados todos los departamentos,
'incluimos is not null, por si en la hoja excel tenemos al final de la base de datos registros en blanco.
sSQL = "SELECT [DATOS$].[SECCION] FROM [DATOS$] WHERE [DATOS$].[SECCION] Is NOT Null " & _
"GROUP BY [DATOS$].[SECCION]"
'limpiamos combobox1
.ComboBox1.Clear
Set Dataread = Recset(sSQL, cnn)
'Con un bucle do cargamos desde el recordset los datos de sección en el combo1
Do Until Dataread.EOF
DEPENDIENTES.ComboBox1.AddItem Dataread("SECCION")
Dataread.MoveNext
Loop
End With
'Desconectamos
Dataread.Close: Set Dataread = Nothing
cnn.Close: Set cnn = Nothing
End Sub

Esta primera macro se inicia cuando el userform se inicializa, básicamente lo que hace es cargar el Combobox1 con los datos de “Sección” y agrupados (registros únicos). Le he incluido un “is not null”, por si al final de la base de datos existiesen registros nulos o en blanco que ocasionen un error de carga.

Pero si os habéis fijado, en la macro he incluido dos “set” llamando a dos funciones: Abre_Cnn y Recset(sSQL, cnn)

Estas dos funciones declaradas publicas, son necesarias para la conexión con la base de datos y con el recordset que grabará información de cada consulta. De esta forma nos evitamos tener que escribir en cada macro el mismo código para conectar y grabar, y simplemente cuando lo necesitemos, invocamos las funciones.

Son estas y también se deben incluir en código del formulario:

Public Function Abre_Cnn() As ADODB.Connection
'Con esta función realizamos la conección con la base de datos
Dim cnn As New ADODB.Connection
Dim bBien As Boolean
bBien = True
On Error GoTo ControlaError
Set cnn = New ADODB.Connection
With cnn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = "DATA SOURCE= " & ThisWorkbook.Path & "\" & "COMBOBOXUSERFORM.xls"
.Properties("Extended Properties") = "Excel 12.0; HDR=YES"
.Open
End With
SALIR:
Set Abre_Cnn = cnn
Exit Function
ControlaError:
bBien = False
Resume SALIR
End Function

Es importante que tengáis en cuenta que la fuente de datos siempre ha de tener la referencia del archivo donde se encuentran los datos y también podéis especificar una ubicación en otra carpeta, en este caso, es el archivo en uso, es decir, el actual:  “DATA SOURCE= ” & ThisWorkbook.Path & “\” & “COMBOBOXUSERFORM.xls”

Public Function Recset(ByVal sSQL As String, ByRef cnn As ADODB.Connection) As ADODB.Recordset
'Con esta función utilizamos el recordset para grabar la información que cargará cada combo
Dim Dataread As New ADODB.Recordset
Dim bBien As Boolean
bBien = True
On Error GoTo ControlaError
With Dataread
.Source = sSQL
.ActiveConnection = cnn
.CursorLocation = adUseClient
.CursorType = adOpenForwardOnly
.LockType = adLockReadOnly
.Open
End With
SALIR:
Set Recset = Dataread
Exit Function
ControlaError:
bBien = False
Resume SALIR
End Function

Ahora que tenemos cargado el combobox1, debemos ir cargando el resto de combos y que vayan haciendo referencia al combo anterior de forma que sean así dependientes. En el código de cada combo debéis insertar cada una de estas macros:

En el Combobox1:

Private Sub ComboBox1_Change()
Dim Dataread As ADODB.Recordset, sSQL As String, cnn As ADODB.Connection
'Llamamos a función Abre_Cnn para conectarnos con la base de datos
Set cnn = Abre_Cnn
With DEPENDIENTES
vSeccion = .ComboBox1.Value
'realizamos consulta seleccionando los estudios filtrados según la seccion a la que pertenecen
sSQL = "SELECT [DATOS$].[ESTUDIOS] FROM [DATOS$]" & _
"WHERE [DATOS$].[ESTUDIOS] AND [DATOS$].[SECCION]='" & vSeccion & "' " & _
"GROUP BY [DATOS$].[ESTUDIOS]"
Set Dataread = Recset(sSQL, cnn)
'limpiamos resto de combos
.ComboBox2.Clear
.ComboBox3.Clear
.ComboBox4.Clear
'cargamos el resultado de la consulta en el combo2 con el recordset
Do Until Dataread.EOF
.ComboBox2.AddItem Dataread("ESTUDIOS")
Dataread.MoveNext
Loop
End With
Dataread.Close: Set Dataread = Nothing
cnn.Close: Set cnn = Nothing
End Sub

En el Combobox2:

Private Sub ComboBox2_Change()
Dim Dataread As ADODB.Recordset, sSQL As String, cnn As ADODB.Connection
'Llamamos a función Abre_Cnn para conectarnos con la base de datos
Set cnn = Abre_Cnn
With DEPENDIENTES
vSeccion = .ComboBox1.Value
vEstudios = .ComboBox2.Value
'realizamos consulta seleccionando el idioma filtrado según la seccion a la que pertenecen y los estudios que poseen
sSQL = "SELECT [DATOS$].[IDIOMA] FROM [DATOS$] WHERE" & _
"[DATOS$].[IDIOMA] AND [DATOS$].[ESTUDIOS]='" & vEstudios & "' AND [DATOS$].[SECCION]='" & vSeccion & "' " & _
"GROUP BY [DATOS$].[IDIOMA]"
Set Dataread = Recset(sSQL, cnn)
.ComboBox3.Clear
.ComboBox4.Clear
'cargamos el resultado de la consulta en el combo3 con el recordset
Do Until Dataread.EOF
.ComboBox3.AddItem Dataread("IDIOMA")
Dataread.MoveNext
Loop
End With
Dataread.Close: Set Dataread = Nothing
cnn.Close: Set cnn = Nothing
End Sub

En el Combobox3

Private Sub ComboBox3_Change()
Dim Dataread As ADODB.Recordset, sSQL As String, cnn As ADODB.Connection
Set cnn = Abre_Cnn
With DEPENDIENTES
vSeccion = .ComboBox1.Value
vEstudios = .ComboBox2.Value
vIdioma = .ComboBox3.Value
'realizamos consulta seleccionando la persona filtrada según la seccion a la que pertenecen y los estudios que poseen y los idiomas
sSQL = "SELECT [DATOS$].[NOMBRE COMPLETO] FROM [DATOS$]" & _
"WHERE [DATOS$].[IDIOMA] AND [DATOS$].[ESTUDIOS]='" & vEstudios & "' AND [DATOS$].[SECCION]='" & vSeccion & "' AND [DATOS$].[IDIOMA]='" & vIdioma & "' " & _
"GROUP BY [DATOS$].[NOMBRE COMPLETO]"
Set Dataread = Recset(sSQL, cnn)
.ComboBox4.Clear
'cargamos el resultado de la consulta en el combo4 con el recordset
Do Until Dataread.EOF
.ComboBox4.AddItem Dataread("NOMBRE COMPLETO")
Dataread.MoveNext
Loop
End With
Dataread.Close: Set Dataread = Nothing
cnn.Close: Set cnn = Nothing
End Sub

Ni que decir tiene que para adaptar estas macros a vuestros proyectos es necesario que tengáis en cuenta el nombres de los campos y la sintaxis SQL.

Finalmente tendréis los cuatro combos dependientes los unos de los otros, y quedaría así.

COMBOBOX DEPENDIENTES EN USERFORM CON SQL3

Este trabajo también se puede hacer en VBA sin incluir SQL ni ADO, pero me ha parecido muy interesante desarrollarlo con de esta forma.

Adicionalmente os dejo otro archivo pero sin el userform, donde he insertado directamente los combobox en la hoja Excel. Existen algunas modificaciones, la macro se inicializa con un evento “Activate” en la hoja “COMBOS”, para cargar el primer Combobox. La diferencia entre uno y otro archivo es que en uno hacemos referencia al userform y en el otro a la hoja.

Sobre el archivo que contiene los combos en la hoja Excel, os comento que tiene una pequeña macro en ThisWorkbook, para que antes de cerrar no guarde los cambios (esto es porque el evento de activar la hoja y subir los datos a los combos, hacen que aunque no hagáis nada en la hoja, cuando la cerráis siempre os solicite guardar o no cambios.

ThisWorkbook.Saved = True
Application.Quit
End Sub

Si no la necesitáis, solo tenéis que borrarla, a vuestro gusto 🙂

Os dejo los dos archivos y si tenéis dudas, ya sabéis, me lo comentáis.

Ahora, como siempre, os dejo los dos archivos 🙂  espero que os sean de utilidad.

Descarga el archivo de ejemplo pulsando en: COMBOBOX EN USERFORM

Descarga el archivo de ejemplo pulsando en: COMBOBOX EN HOJA