Jump to content
Sign in to follow this  
Antoni

Crear ListBox/ComboBox sin duplicados

Recommended Posts

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

Share this post


Link to post
Share on other sites
Sign in to follow this  



×
×
  • Create New...

Important Information

Privacy Policy