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
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 Function

y este la implementacion

Call AgregarItems(Me.ComboBox1, "PRUEBA", "Reclamado", 9, 2)
Respuesta
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

.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas