Como Agregar 10 Columnas en una ListBox

Estoy creando una búsqueda con Userform

Este es mi código pero no busca

Private Sub btn_Buscar_Click()

If Me.txt_Buscar.Value = Empty Then
MsgBox "Escriba un registro para buscar"
Me.ListBox1.Clear
Me.txt_Buscar.SetFocus
Exit Sub
End If
Me.ListBox1.Clear

items = Range("Table1").CurrentRegion.Rows.Count
For i = 10 To items
If LCase(Cells(i, 1).Value) Like "*" & LCase(Me.txt_Buscar.Value) & "*" Then
Me.ListBox1.AddItem Cells(i, 1)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = Cells(i, 1)
ElseIf LCase(Cells(i, 2).Value) Like "*" & LCase(Me.txt_Buscar.Value) & "*" Then
Me.ListBox1.AddItem Cells(i, 1)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = Cells(i, 2)
ElseIf LCase(Cells(i, 3).Value) Like "*" & LCase(Me.txt_Buscar.Value) & "*" Then
Me.ListBox1.AddItem Cells(i, 1)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = Cells(i, 3)
ElseIf LCase(Cells(i, 4).Value) Like "*" & LCase(Me.txt_Buscar.Value) & "*" Then
Me.ListBox1.AddItem Cells(i, 1)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = Cells(i, 4)
ElseIf LCase(Cells(i, 5).Value) Like "*" & LCase(Me.txt_Buscar.Value) & "*" Then
Me.ListBox1.AddItem Cells(i, 1)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = Cells(i, 5)
ElseIf LCase(Cells(i, 6).Value) Like "*" & LCase(Me.txt_Buscar.Value) & "*" Then
Me.ListBox1.AddItem Cells(i, 1)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = Cells(i, 6)

ElseIf LCase(Cells(i, 7).Value) Like "*" & LCase(Me.txt_Buscar.Value) & "*" Then
Me.ListBox1.AddItem Cells(i, 1)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = Cells(i, 7)
ElseIf LCase(Cells(i, 8).Value) Like "*" & LCase(Me.txt_Buscar.Value) & "*" Then
Me.ListBox1.AddItem Cells(i, 1)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = Cells(i, 8)
ElseIf LCase(Cells(i, 9).Value) Like "*" & LCase(Me.txt_Buscar.Value) & "*" Then
Me.ListBox1.AddItem Cells(i, 1)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = Cells(i, 9)
ElseIf LCase(Cells(i, 10).Value) Like "*" & LCase(Me.txt_Buscar.Value) & "*" Then
Me.ListBox1.AddItem Cells(i, 1)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = Cells(i, 10)
End If
Next i
Me.txt_Buscar.SetFocus
Me.txt_Buscar.SelStart = 0
Me.txt_Buscar.SelLength = Len(Me.txt_Buscar.Text)
Exit Sub

End Sub

Private Sub btn_Eliminar_Click()

Dim Fila As Integer
Dim Final As Integer

If Me.ListBox1.ListIndex = -1 Then
MsgBox "Debe seleccionar un registro"
Exit Sub
End If

Fila = 7
Do While Hoja1.Cells(Fila, 1) <> ""
Fila = Fila + 1
Loop
Final = Fila - 1

If MsgBox("¿Seguro que quiere eliminar este Registro?", vbQuestion + vbYesNo) = vbYes Then
For Fila = 2 To Final
If Hoja1.Cells(Fila, 1) = xEmpleado Then
Hoja1.Cells(Fila, 1).EntireRow.Delete
Exit For
End If
Next
Call btn_Buscar_Click
MsgBox "Registro eliminado", vbInformation + vbOKOnly
Else
Exit Sub
End If
End Sub

Respuesta
1

El título del mensaje dice que necesitas agregar columnas pero el mensaje habla de buscar datos y envías procedimientos de objetos ¿cuál es, finalmente, tu problema?

Abraham Valencia

1 respuesta más de otro experto

Respuesta
2

Te ajusté la macro para buscar con el método Find( ) y te agregué un ciclo For para agregar las columnas de la A al J.

Nota: Tu listbox deberá tener en la propiedad ColumnCount =10

El código:

Private Sub btn_Buscar_Click()
'Por Dante Amor
    '
    If Me.txt_Buscar.Value = Empty Then
        MsgBox "Escriba un registro para buscar"
        Me.ListBox1.Clear
        Me.txt_Buscar.SetFocus
        Exit Sub
    End If
    Me.ListBox1.Clear
    '
    'Buscar con Find()
    Set r = Columns("A:J")
    Set b = r.Find(txt_Buscar, LookAt:=xlPart)
    If Not b Is Nothing Then
        celda = b.Address
        Do
            'detalle
            ListBox1.AddItem
            u = ListBox1.ListCount - 1
            For i = Columns("A").Column To Columns("J").Column 'agrega las 10 columnas de la A a la J
                ListBox1.List(u, i - 1) = Cells(b.Row, i)
            Next
            Set b = r.FindNext(b)
        Loop While Not b Is Nothing And b.Address <> celda
    Else
        MsgBox "No se encontraron coincidencias"
    End If
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