Macro que me agregue los registros a un combobox
Necesito macro que me agregue registros único de la Columna B siempre y cuando la columna I se igual a "Reclamado", ¿se puede crear alguna función global condicional?.
2 Respuestas
Respuesta de san lo
1
Googleando he encontrado esta función, pero no me funciona:
Function AgregarItems(Cmb As ComboBox, Hoja As String, Cond As String, ColCond As Integer, ColDato As Integer)
Dim collec As New Collection
Sheets(Hoja).Activate
Range("A2").Activate
On Error Resume Next
Do While ActiveCell.Value <> ""
If ActiveCell.Offset(0, ColCond) = Cond Then
Err.Clear
collec.Add CStr(ActiveCell.Offset(0, ColDato)), CStr(ActiveCell.Offset(0, ColDato))
If Err.Number = 0 Then Cmb.AddItem ActiveCell.Offset(0, ColDato)
End If
ActiveCell.Offset(1, 0).Activate
Loop
On Error GoTo 0
End Functiony este la implementacion
Call AgregarItems(Me.ComboBox1, "PRUEBA", "Reclamado", 9, 2)
Respuesta de Dante Amor
1
Utiliza el siguiente código
Private Sub UserForm_Initialize()
'Por.Dante Amor
Set h = Sheets("PRUEBA")
For i = 2 To h.Range("B" & Rows.Count).End(xlUp).Row
If h.Cells(i, "I").Value = "Reclamado" Then
Call Agregar(ComboBox1, h.Cells(i, "B"))
End If
Next
End Sub
'
Sub Agregar(combo As ComboBox, dato As String)
'Por.DAM agrega los item únicos y en orden alfabético
For i = 0 To combo.ListCount - 1
Select Case StrComp(combo.List(i), dato, vbTextCompare)
Case 0: Exit Sub 'ya existe en el combo y ya no lo agrega
Case 1: combo.AddItem dato, i: Exit Sub 'Es menor, lo agrega antes del comparado
End Select
Next
combo.AddItem dato 'Es mayor lo agrega al final
End Sub.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
.
Avísame cualquier duda
.