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
2 respuestas
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
.
