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 F_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.

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:

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:

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.

¡¡Muchas gracias!!