Macro para buscar datos en un rango que se encuentra en la misma hoja
Como lo solicitaste abro una nueva pregunta. Recientemente me pasaste una macro que resolvía mi problema, pero me preguntaba si se la puede mejorar un poco, haciendo que no solo encuentre la similitud, sino que tenga un botón para pasar a la siguiente coincidencia o mejor todavía, que despliegue una lista de la cual seleccionar el dato requerido. Te paso la macro que me pasaste para que te des una idea de lo que te hablo.
Sub Buscar_Datos()
'Por.Dante Amor
f = 10005
Do While Cells(f, "I") <> ""
Set b = Range("C6:C10001").Find(Cells(f, "I"), lookat:=xlWhole)
If Not b Is Nothing Then
Cells(f, "A") = Cells(b.Row, "A")
Cells(f, "B") = Cells(b.Row, "B")
Cells(f, "C") = Cells(b.Row, "C")
End If
f = f + 1
Loop
MsgBox "Fin"
End Sub
1 Respuesta
Envíame tu archivo para adaptar un formulario y la macro pueda llenar una lista.
Mi correo [email protected]
En el asunto del correo escribe tu nombre de usuario “Martin Antonio Bruno”
S a l u d o s . D a n t e A m o r
Te envíe el archivo al correo Dante. Saludos!
Te anexo el código para el formulario
Dim h1, h2
'
Private Sub CommandButton1_Click()
'Por.Dante Amor
If ListBox1.ListIndex = -1 Then
MsgBox "Selecciona un registro de la lista"
Exit Sub
End If
'
u = h1.Range("C" & Rows.Count).End(xlUp).Row + 1
h1.Cells(u, "A") = ListBox1.List(ListBox1.ListIndex, 0)
h1.Cells(u, "B") = ListBox1.List(ListBox1.ListIndex, 1)
h1.Cells(u, "C") = ListBox1.List(ListBox1.ListIndex, 2)
h1.Cells(u, "C").Select
Unload Me
End Sub
'
Private Sub TextBox1_Change()
'Por.Dante Amor
h2.Rows("2:" & Rows.Count).Clear
u = 6
j = 2
Do While h1.Cells(u, "C") <> ""
cadena = h1.Cells(u, "A") & h1.Cells(u, "B") & h1.Cells(u, "C")
If LCase(cadena) Like "*" & LCase(TextBox1.Value) & "*" Then
h1.Rows(u).Copy h2.Rows(j)
j = j + 1
End If
u = u + 1
Loop
h2.Cells.EntireColumn.AutoFit
For i = 1 To 16
anch = anch & Int(h1.Cells(1, i).Width) + 3 & ";"
Next
u = h2.Range("C" & Rows.Count).End(xlUp).Row
rango = h2.Range(h2.Cells(2, "A"), h2.Cells(j, 16)).Address
ListBox1.RowSource = h2.Name & "!" & rango
ListBox1.ColumnWidths = anch
End Sub
'
Private Sub UserForm_Activate()
'Por.Dante Amor
Set h1 = ActiveSheet
Set h2 = Sheets("Temp")
h2.Rows("2:" & Rows.Count).Clear
u = 6
Do While h1.Cells(u, "C") <> ""
u = u + 1
Loop
h1.Range("A6:P" & u).Copy h2.Range("A2")
h2.Cells.EntireColumn.AutoFit
For i = 1 To 16
anch = anch & Int(h1.Cells(1, i).Width) + 3 & ";"
Next
u = h2.Range("C" & Rows.Count).End(xlUp).Row
rango = h2.Range(h2.Cells(2, "A"), h2.Cells(u, 16)).Address
ListBox1.RowSource = h2.Name & "!" & rango
ListBox1.ColumnWidths = anch
End Sub
'
Private Sub CommandButton2_Click()
Unload Me
End Sub
.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
.
Avísame cualquier duda
.
Gracias Dante! Justo te iba a preguntar por la macro porque no la encontraba. ¿Podrías explicarme como funciona la hoja Temp? Por que veo que tiene los datos de la hoja 62, que es donde esta el botón buscar.
Es para poner temporalmente los registros que coinciden con el criterio de búsqueda
