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

Respuesta
1

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 Sub

Para 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

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas