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:

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:

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.



¡¡Muchas gracias!!