Mostrar datos cuando se ingresa una palabra en un TextBox-VBA
Tengo un inconveniente con un proyecto de Excel, el cual quiero que al ingresar un dato en un TextBox, me busque en una hoja ya creada en Excel todos los datos relacionados con lo ingresado en el TextBox.
Código:
Este código lo que hace es que al ingresar un dato (ej: "1234") busca en la hoja de Excel creada (en este caso BASE INGRESO) en la columna ("A") el dato que se ingreso por teclado, lo que sucede es que si hay dentro de la hoja de Excel 5 datos con el número "1234" solo me muestra el primero que encuentra y el resto no me los deja ver en el ListBox.
Tabla en la Hoja BASE INGRESO:
Private Sub Buscar_Click()
If Trim(TextBuscar.Text) = "" Then
MsgBox "POR FAVOR INGRESE ALGÚN DATO.", vbExclamation, "Alerta"
TextBuscar.SetFocus
Exit Sub
End If
For i = 2 To 10000
If OpcionIngreso.Value = True And TextBuscar.Text = Worksheets("BASE INGRESO").Range("A" & i).Value Then
Me.ListBuscar.AddItem (Worksheets("BASE INGRESO").Range("C" & i).Value)
TextBuscar.SetFocus
Exit Sub
End If
Next i
End SubPor favor, sería de gran ayuda poder solucionar este problema, apenas comienzo con este VBA.
2 Respuestas
[Hola
Te paso la macro. Para que busques con la primer option "INGRESO"
Has lo mismo para el resto, solo cambia las columnas
Private Sub Buscar_Click()
'Fuente Dante
'Act. por Adriel
Set h1 = Sheets("Hoja1")
'
If OpcionIngreso Then
ListBuscar.Clear
For i = 2 To h1.Range("A" & Rows.Count).End(xlUp).Row
cad = h1.Cells(i, "A") & UCase(h1.Cells(i, "A")) 'Buscar en la columna B
If cad Like "*" & UCase(Txtbuscar) & "*" Then
With ListBuscar
. AddItem h1.Cells(i, "A")
. List(.ListCount - 1, 1) = h1.Cells(i, "B")
. List(.ListCount - 1, 2) = h1.Cells(i, "C")
. List(.ListCount - 1, 3) = h1.Cells(i, "D")
. List(.ListCount - 1, 4) = h1.Cells(i, "E")
. List(.ListCount - 1, 4) = h1.Cells(i, "F")
End With
End If
Next
End If
End SubValora la respuesta para finalizar saludos!
Prueba lo siguiente, en esta parte tienes un Exit Sub
If OpcionIngreso.Value = True And TextBuscar.Text = Worksheets("BASE INGRESO").Range("A" & i).Value Then
Me.ListBuscar.AddItem (Worksheets("BASE INGRESO").Range("C" & i).Value)
TextBuscar.SetFocus
Exit Sub
End IfQuita ese Exit Sub, para que siga buscando.
De cualquier manera te anexo mi versión del código:
Private Sub Buscar_Click()
ListBuscar.Clear
If IsNumeric(TextBuscar.Value) Then wtext = Val(TextBuscar) Else wtext = TextBuscar
If Trim(wtext) = "" Then
MsgBox "POR FAVOR INGRESE ALGÚN DATO.", vbExclamation, "Alerta"
TextBuscar.SetFocus
Exit Sub
End If
Set h = Sheets("BASE INGRESO")
If OpcionIngreso.Value = True Then
Set r = h.Columns("A")
Set b = r.Find(wtext, LookAt:=xlWhole)
If Not b Is Nothing Then
celda = b.Address
Do
ListBuscar.AddItem h.Cells(b.Row, "C").Value
Set b = r.FindNext(b)
Loop While Not b Is Nothing And b.Address <> celda
End If
End If
End Sub.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
.
Avísame cualquier duda
.