VBA omitir items duplicados en combobox
Espero se encuentren de lo mejor.
Recurro a los expertos, después de estar algunos días intentando finalizar un formulario sin éxito.
Lo que resulta es que tengo un combobox que se rellena de manera dependiente, sin embargo me esta duplicando los registros:
Private Sub ComboBox1_change()
Dim fila As Integer
'Dim uf As Integer
Dim d1, d2 As String
Application.ScreenUpdating = False
fila = 2
ComboBox2.Clear
While Sheets("Op´s").Cells(fila, 2) <> Empty
d1 = ComboBox1
d2 = Sheets("Op´s").Cells(fila, 2)
If d1 = d2 Then
'En esta parte no se como validar si ya existe, no agregar
ComboBox2.AddItem Sheets("Op´s").Cells(fila, 3)
End If
fila = fila + 1
Wend
End Sub
2 respuestas
Este es un ejemplo de como cargarlo a usando una colección
y esta es la macro
Private Sub UserForm_Initialize()
Dim unicos As New Collection
Set datos = Range("a2").CurrentRegion
With datos
filas = .Rows.Count
For i = 1 To filas
nombre = .Cells(i, 1)
On Error Resume Next
unicos.Add nombre, CStr(nombre)
If Err.Number = 0 Then ComboBox1.AddItem nombre
On Error GoTo 0
Next i
ComboBox1.ListIndex = 0
End With
End Sub
Hola James, ese código lo utilizo para cargar las ordenes de producción al inizializar el form, sin embargo una vez seleccionada la orden de producción, se llena el combobox 2, como se muestra en la imagen que anexo, como hacer dentro del Private Sub ComboBox1_change() para evitar añadir registros duplicados al combobox2?
Private Sub ComboBox1_change()
Dim fila As Integer
'Dim uf As Integer
Dim d1, d2 As String
Application.ScreenUpdating = False
fila = 2
ComboBox2.Clear
While Sheets("Op´s").Cells(fila, 2) <> Empty
d1 = ComboBox1
d2 = Sheets("Op´s").Cells(fila, 2)
If d1 = d2 Then
'En esta parte no se como validar si ya existe, no agregar
ComboBox2.AddItem Sheets("Op´s").Cells(fila, 3)
End If
fila = fila + 1
Wend
End SubMuchas gracias por tu ayuda. James Bond
Pues es mas o menos lo mismo solo hay que hacerle las siguientes variaciones
y va de nuevo la macro
Private Sub ComboBox1_Change()
Dim unicos As New Collection
Set datos = Range("b2").CurrentRegion
op = ComboBox1.Value
With datos
cuenta = WorksheetFunction.CountIf(.Columns(1), op)
fila = WorksheetFunction.Match(op, .Columns(1), 0)
Set oper = .Rows(fila).Resize(cuenta)
ComboBox2.Clear
For i = 1 To cuenta
maquina = oper.Cells(i, 3)
On Error Resume Next
unicos.Add maquina, CStr(maquina)
If Err.Number = 0 Then ComboBox2.AddItem maquina
On Error GoTo 0
Next i
End With
Set datos = Nothing
End Sub
Private Sub UserForm_Initialize()
Dim unicos As New Collection
Set datos = Range("b2").CurrentRegion
ComboBox1.Clear
With datos
filas = .Rows.Count
For i = 2 To filas
nombre = .Cells(i, 1)
On Error Resume Next
unicos.Add nombre, CStr(nombre)
If Err.Number = 0 Then ComboBox1.AddItem nombre
On Error GoTo 0
Next i
ComboBox1.ListIndex = 0
End With
End Sub
este es el resultado de la macro
Suponiendo que el rango de celdas donde se encuentran los elementos para el combobox tenga aplicado un nombre llamado Lista, el siguiente código elimina los duplicados que pueda haber y los incorpora al ComboBox2 del formulario al inicializarse el mismo:
Private Sub UserForm_Initialize()
On Error GoTo captura
Dim n As Long
For n = 1 To Range("Lista").Rows.Count
Me.ComboBox2.AddItem Evaluate("=INDEX(Lista,SMALL(IF(MATCH(Lista,Lista,0)=ROW(INDIRECT(" & """1:""" & "&COUNTA(Lista))),MATCH(Lista,Lista,0)," & """""" & ")," & n & "-ROW(Lista)+1))")
Next n
Exit Sub
captura:
If Err.Number = -2147352571 Then Exit Sub Else MsgBox Err.Number & " - " & Err.Description
End SubSaludos_