Crear ListBox/ComboBox sin duplicados

Antoni · el 9 de noviembre

Después de ver este post solucionado por mjrofra, me ha parecido interesante, y esperando que no se moleste, me atrevo a subirlo aquí:

Partiendo de la base que queremos cargar un ListBox/ComboBox con los datos de la columna A que tiene una fila de encabezamiento.

mjrofra nos propone usar una matriz y una colección, lo bueno de este sistema es que nos vale para ambos controles.

Sub CargarÚnicosListboxCombobox()


Dim matriz As Variant

Dim dato As Variant

Dim unicos As New Collection


matriz = Range("A2", Range("A" & Rows.Count).End(xlUp))


On Error Resume Next

For Each dato In matriz

    unicos.Add dato, CStr(dato)

Next dato

On Error GoTo 0


For Each dato In unicos

    Me.ListBox1.AddItem dato

Next dato


Set unicos = Nothing

Erase matriz


End Sub


[/CODE]

Otra forma consiste en una variación del mismo principio que usa [i][b]mjrofra[/b][/i], aprovecharnos de un error, en este caso el que se produce cuando se iguala la propiedad [i][b]Text [/b][/i]del [i][b]ListBox [/b][/i]con un valor que no existe en el [i][b]ListBox[/b][/i]:

[CODE]

Sub CargarUnicosListBox(): On Error GoTo Único '<========
Dim celda As Range

For Each celda In Range("A2", Range("A" & Rows.Count).End(xlUp))
ListBox1.Text = celda.Value 'Si no existe se produce error y salta a Único
Next celda
Exit Sub

Único:
ListBox1.AddItem celda.Value
Resume Next 'Vuelve a Next celda

End Sub

[/CODE]

Pero este sistema no nos vale para un ComboBox.

Para hacer lo mismo con un control [i][b]ComboBox, [/b][/i]hemos de cambiar de táctica, ya que al mover el valor a la propiedad [i][b]Text [/b][/i]del control, en lugar de producirse error, nos [i][b]devuelve -1[/b][/i] en el valor del índice del [i][b]ComboBox[/b][/i].

[CODE]
Sub CargarUnicosComboBox()
Dim celda As Range

For Each celda In Range("A2", Range("A" & Rows.Count).End(xlUp))
ComboBox1.Text = celda.Value
If ComboBox1.ListIndex = -1 Then ComboBox1.AddItem celda.Value
Next celda

End Sub

[/CODE]

Los tres procedimientos han sido probados y funcionan correctamente.

Espero que os guste y sobre todo, que os sea útil.

Saludos a todos