Macro Excel Busqueda ListBox ampliar rango de respuesta
Tengo el siguiente código que busca valores en la columna A y los entrega en un ListBox, pero necesito que el rango que entrega sea mayor, desde A:H la columna 1 hasta 8 que es la ultima columna, además mostrá el encabezado de los datos.
Este es el código
Private Sub BusquedaManual()
Dim palabra As String
Dim palabra2 As String
Dim i As Long
Call EliminarContenido
palabra = "*" & BusquedaTxt.Value & "*"
palabra2 = BusquedaTxt.Value
Sheets("Hoja1").Select
If IsNumeric(palabra2) Or palabra2 = "" Then
For i = 2 To Range("A6500").End(xlUp).Row
If Range("A" & i).Value Like palabra Then
UserForm1.ContenidoRol.AddItem Range("A" & i).Value
End If
Next
Else
'MAYUSCULA
palabra = UCase(palabra)
For i = 2 To Range("A6500").End(xlUp).Row
If Range("A" & i).Value Like palabra Then
UserForm1.ContenidoRol.AddItem Range("A" & i).Value
End If
Next
'minuscula
palabra = LCase(palabra)
For i = 2 To Range("A6500").End(xlUp).Row
If Range("B" & i).Value Like palabra Then
UserForm1.ContenidoRol.AddItem Range("A" & i).Value
End If
Next
'Mayuscula
palabra = Application.WorksheetFunction.Proper(palabra)
For i = 2 To Range("A6500").End(xlUp).Row
If Range("A" & i).Value Like palabra Then
UserForm1.ContenidoRol.AddItem Range("A" & i).Value
End If
Next
End If
Sheets("Hoja1").Select
End Sub
1 respuesta
Cambia por esta macro
Private Sub BusquedaManual_Click()
Call EliminarContenido
'
Set r = Columns("A")
Set b = r.Find(BusquedaTxt, lookat:=xlPart)
If Not b Is Nothing Then
ncell = b.Address
Do
'detalle
ContenidoRol.AddItem Cells(b.Row, "A")
ContenidoRol.List(ContenidoRol.ListCount - 1, 1) = Cells(b.Row, "B")
ContenidoRol.List(ContenidoRol.ListCount - 1, 2) = Cells(b.Row, "C")
ContenidoRol.List(ContenidoRol.ListCount - 1, 3) = Cells(b.Row, "D")
ContenidoRol.List(ContenidoRol.ListCount - 1, 4) = Cells(b.Row, "E")
ContenidoRol.List(ContenidoRol.ListCount - 1, 5) = Cells(b.Row, "F")
ContenidoRol.List(ContenidoRol.ListCount - 1, 6) = Cells(b.Row, "G")
ContenidoRol.List(ContenidoRol.ListCount - 1, 7) = Cells(b.Row, "H")
Set b = r.FindNext(b)
Loop While Not b Is Nothing And b.Address <> ncell
End If
'
Sheets("Hoja1").Select
End SubPara que los encabezados se carguen, tienes que cargar la información al listbox con la propiedad rowsource.
La propiedad rowsource carga un rango de datos, pero en tu caso no estás cargando un rango, estás cargando datos que cumplan con cierta condición.
Entonces, si va a utilizar el método additem, te sugiero que pongas etiquetas en tu formulario, puede ser así:
Saludos. Dante Amor
