Macro para cargar combobox sin duplicados
Tengo la siguiente macro para cargar un combobox sin duplicados, pero no me salen todos los registro.
Private Sub UserForm_Initialize()
Dim fila As Integer, final As Integer, registro As Integer
fila = 1
Do While Hoja8.Cells(fila, 2) <> ""
fila = fila + 1
Loop
final = fila - 1
With Hoja8
For fila = 2 To final
registro = WorksheetFunction.CountIf(.Range(.Cells(1, 1), .Cells(fila, 1)), .Cells(fila, 1))
If registro = 1 Then
cbo_not.AddItem .Cells(fila, 1)
End If
Next fila
End With
2 Respuestas
A la excelente respuesta dada te agrego esto por si te es de utilidad y aporta algo más
https://macrosenexcel.com/combobox-sin-duplicados
https://macrosenexcel.com/macro-lista-datos-sin-duplicados
https://macrosenexcel.com/como-cargar-datos-sin-duplicar-en-un
- Compartir respuesta
Lo que debe estar pasando es que buscas el fin de rango en col 2 (Do While Hoja8. Cells(fila, 2) <> "")
Pero luego llenas el combobox desde la col 1 y quizás haya más datos que el fin de rango que encontraste en col 2 si tu col B se parece a la imagen:
Te dejo la macro ajustada. Si no se encuentran otros datos debajo de tu tabla puedes utilizar la única instrucción que busca la variable 'final' en lugar de recorrer toda la tabla.
Private Sub UserForm_Initialize() Dim fila As Integer, final As Integer, registro As Integer final = Hoja8.Range("A" & Rows.Count).End(xlUp).Row With Hoja8 For fila = 2 To final registro = WorksheetFunction.CountIf(.Range(.Cells(1, 1), .Cells(fila, 1)), .Cells(fila, 1)) If registro = 1 Then cbo_not.AddItem .Cells(fila, 1) End If Next fila End With End Sub
Buenas
Tal y como te comente ya no aparecen registros repetidos, pero ahora al cargar los datos del combobox no se rellenan el resto de casillas.
Pongo todo el código.
Private Sub UserForm_Initialize()
Dim Fila As Integer, Final As Integer, registro As Integer
Final = Hoja8.Range("A" & Rows.Count).End(xlUp).Row
With Hoja8
For Fila = 2 To Final
registro = WorksheetFunction.CountIf(.Range(.Cells(1, 1), .Cells(Fila, 1)), .Cells(Fila, 1))
If registro = 1 Then
cbo_not.AddItem .Cells(Fila, 1)
End If
Next Fila
End With
ListBox1.ColumnCount = 7
Me.ListBox1.ColumnWidths = "50pt; 150 pt;60 pt;60 pt;250 pt;60 pt;60 pt"
End Sub
Private Sub cbo_not_Change()
Dim Fila As Integer
Dim Final As Integer
If cbo_not.Value = "" Then
Me.cbo_pt = ""
Me.txt_fecha = ""
Me.txt_descrip = ""
Me.eje1 = ""
Me.eje2 = ""
Me.eje3 = ""
Me.txt_equipo = ""
End If
For Fila = 2 To 1000
If Hoja8.Cells(Fila, 1) = "" Then
Final = Fila - 1
Exit For
End If
Next
For Fila = 2 To Final
If cbo_not = Hoja8.Cells(Fila, 1) Then
Me.cbo_pt = Hoja8.Cells(Fila, 3)
Me.txt_equipo = Hoja8.Cells(Fila, 4)
Me.txt_fecha = Hoja8.Cells(Fila, 2)
Me.txt_descrip = Hoja8.Cells(Fila, 5)
Me.eje1 = Hoja8.Cells(Fila, 6)
Me.eje2 = Hoja8.Cells(Fila, 7)
Me.eje3 = Hoja8.Cells(Fila, 8)
Exit For
End If
Next
End Sub
Private Sub CommandButton1_Click()
Dim Fila, Final As Integer
Fila = 2
For Fila = 2 To Final
If Me.cbo_not = Hoja8.Cells(Fila, 1) Then
Exit For
End If
Next
If Me.cbo_not.Value = Empty Then
Me.ListBox1.Clear
' Me.txt_equipo = Empty
' Me.txt_marcaymodelo = Empty
' Me.txt_saldo = Empty
'MsgBox "Escriba un codigo para buscar"
'Me.txt_buscar.SetFocus
' Exit Sub
End If
Me.ListBox1.Clear
items = Hoja8.Range("tabla5").CurrentRegion.Rows.Count
For i = 2 To items
If Hoja8.Cells(i, 1).Value Like Me.cbo_not.Value _
And Hoja8.Cells(i, 2).Value Like Me.txt_fecha Then
Me.ListBox1.AddItem Hoja8.Cells(i, 9)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = Hoja8.Cells(i, 10)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = Hoja8.Cells(i, 11)
' Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = Hoja8.Cells(i, 11)
'Me.ListBox1.List(Me.ListBox1.ListCount - 1, 4) = Hoja8.Cells(i, 11)
' Me.ListBox1.List(Me.ListBox1.ListCount - 1, 5) = Hoja3.Cells(i, 12)
'Me.ListBox1.List(Me.ListBox1.ListCount - 1, 6) = Hoja3.Cells(i, 13)
End If
Next i
Exit Sub
End Sub
Creo que casi todo lo que comento a continuación en el código ya lo comenté... o me estoy confundiendo de usuario lo que también es probable ;)
Copia el código tal como te lo dejo. Porque estás utilizando una variable 'Final' que siempre empieza de 0 al declararla dentro de la subrutina cuando debiera estar fuera para uso general.
Dim Final As Integer Private Sub UserForm_Initialize() Dim Fila As Integer, registro As Integer 'encontrar última celda con datos en col A..... fin de rango Final = Hoja8.Range("A" & Rows.Count).End(xlUp).Row With Hoja8 For Fila = 2 To Final registro = WorksheetFunction.CountIf(.Range(.Cells(1, 1), .Cells(Fila, 1)), .Cells(Fila, 1)) If registro = 1 Then cbo_not.AddItem .Cells(Fila, 1) End If Next Fila End With ListBox1.ColumnCount = 7 Me.ListBox1.ColumnWidths = "50pt; 150 pt;60 pt;60 pt;250 pt;60 pt;60 pt" End Sub Private Sub cbo_not_Change() Dim Fila As Integer 'Dim Final As Integer 'la variable se utiliza de modo público ... se declara al inicio del módulo If cbo_not.Value = "" Then Me.cbo_pt = "" Me.txt_fecha = "" Me.txt_descrip = "" Me.eje1 = "" Me.eje2 = "" Me.eje3 = "" Me.txt_equipo = "" EXIT SUB 'si el combo está vacío debe cancelar el evento Change End If 'encontrar última fila con datos.... con 1 sola instrución ! ! Final = Hoja8.Range("A" & Rows.Count).End(xlUp).Row 'For Fila = 2 To 1000 'If Hoja8.Cells(Fila, 1) = "" Then 'Final = Fila - 1 'Exit For 'End If 'Next For Fila = 2 To Final If cbo_not = Hoja8.Cells(Fila, 1) Then Me.cbo_pt = Hoja8.Cells(Fila, 3) 'evita los ME ! ! Me.txt_equipo = Hoja8.Cells(Fila, 4) Me.txt_fecha = Hoja8.Cells(Fila, 2) Me.txt_descrip = Hoja8.Cells(Fila, 5) Me.eje1 = Hoja8.Cells(Fila, 6) Me.eje2 = Hoja8.Cells(Fila, 7) Me.eje3 = Hoja8.Cells(Fila, 8) Exit For End If Next End Sub Private Sub CommandButton1_Click() Dim Fila as Integer 'Dim Final As Integer 'la variable se utiliza de modo público ... se declara al inicio del módulo Fila = 2 For Fila = 2 To Final If Me.cbo_not = Hoja8.Cells(Fila, 1) Then Exit For End If Next If Me.cbo_not.Value = Empty Then 'evita los Me ! ! Me.ListBox1.Clear ' Me.txt_equipo = Empty ' Me.txt_marcaymodelo = Empty ' Me.txt_saldo = Empty 'MsgBox "Escriba un codigo para buscar" 'Me.txt_buscar.SetFocus ' Exit Sub End If Me.ListBox1.Clear items = Hoja8.Range("tabla5").CurrentRegion.Rows.Count For i = 2 To items If Hoja8.Cells(i, 1).Value Like Me.cbo_not.Value _ And Hoja8.Cells(i, 2).Value Like Me.txt_fecha Then Me.ListBox1.AddItem Hoja8.Cells(i, 9) Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = Hoja8.Cells(i, 10) Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = Hoja8.Cells(i, 11) ' Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = Hoja8.Cells(i, 11) 'Me.ListBox1.List(Me.ListBox1.ListCount - 1, 4) = Hoja8.Cells(i, 11) ' Me.ListBox1.List(Me.ListBox1.ListCount - 1, 5) = Hoja3.Cells(i, 12) 'Me.ListBox1.List(Me.ListBox1.ListCount - 1, 6) = Hoja3.Cells(i, 13) End If Next i 'Exit Sub 'No hace falta Exit sub si luego viene el End Sub End Sub
Cuando hagas un poco de limpieza en el código lo verás mucho más claro.
Si luego queda aún algo por ajustar me lo envías nuevamente.
Sdos!
¡Gracias!
Aunque esto que me compartiste me vino bien para depurar el código no funciono. Creo que es debido a como introduzco los datos . que es a través de otro formulario.
Este punto del código creo que es el me da problemas , por que en otro formulario de búsqueda no me da ese problema. (Hoja8.Cells(Final, 2) = Me.txt_fecha.Text)
Hoja8.Cells(Final, 1) = Comprb
Espero esta vez haberme explicado bien.
Private Sub btn_Procesar_Click()
Dim Fila As Integer
Dim Final As Integer
Dim Existencia As Integer
Dim altas As Integer
Dim Comprb As Long
Hoja4.Range("h1").Value = Hoja4.Range("h1").Value + 1
Comprb = Hoja4.Range("h1").Value
If Me.cbo_not.Text = Empty Or _
Me.txt_fecha.Text = Empty Or _
Me.eje1.Text = Empty Or _
Me.eje2.Text = Empty Or _
Me.ListBox1.ListCount = 0 Or _
Me.ListBox2.ListCount = 0 Then
MsgBox "Hay cambios vacios en el PARTE"""
Exit Sub
End If
Fila = 2
Do While Hoja8.Cells(Fila, 1) <> ""
Fila = Fila + 1
Loop
Final = Fila
For i = 0 To Me.ListBox1.ListCount - 1
Hoja8.Cells(Final, 9) = Me.ListBox1.List(i, 0)
Hoja8.Cells(Final, 10) = Me.ListBox1.List(i, 1)
Hoja8.Cells(Final, 11) = Me.ListBox1.List(i, 2)
Hoja8.Cells(Final, 1) = Comprb
Hoja8.Cells(Final, 2) = Me.txt_fecha.Text
Hoja8.Cells(Final, 3) = Me.cbo_not
Hoja8.Cells(Final, 4) = Me.txt_equipo
Hoja8.Cells(Final, 5) = Me.txt_descrip
Hoja8.Cells(Final, 6) = Me.eje1
Hoja8.Cells(Final, 7) = Me.eje2
Hoja8.Cells(Final, 8) = Me.eje3
Final = Final + 1
Next i
Entonces coloca en un libro los 2 uf y la hoja de trabajo con solo un par de datos y envíamelo al correo cibersoft. Arg de Gmail.
(Aparecen en portada de mi sitio)
Sdos!
Lo que mencionas que falla no tiene que nada que ver con el tema de la consulta original (llenar un combobox sin duplicados).
La parte del código que no está correcto aunque no da error la instrucción, es la del guardado de la fecha. Y esto para todos los UF donde tengas que guardar fechas en celdas.
Los controles Textbox guardan texto (en la imagen fechas alineadas a izquierda como texto).
Utiliza CDATE para convertirlas a fechas válidas.
Hoja8.Cells(Final, 2) = CDate(Me.txt_fecha.Text)
PD) Con esto damos por cerrado esta consulta ... que nos estamos saliendo del tema.
Sdos!
- Compartir respuesta