Duda sobre consulta de trabajador
Y buenas tardes a los miembros de este prestigioso foro, en esta oportunidad requiero de su ayuda, al presionar el Botón “Busca Código”, digitamos el 3022 a buscar, que será desde la columna A2 hasta A5000, y donde se ubique el código buscado resalte la columna E, donde este resalto el código buscado en la columna A, para así poder realizar los cambios que se requiera, adjunto macro.
Sub BuscarTrabajador2017()
'Este macro busca ahora por Nombre
Dim Celda As Range
Dim palabra As String
palabra = InputBox("Buscar por Nombre3333...")
palabra = "*" & palabra & "*"
For Each Celda In Range("A2:A5000")
Celda.Interior.ColorIndex = 0
Celda.Characters(posicion, Len(palabra)).Font.Color = vbBlack
If Celda.Value Like UCase(palabra) Then
Celda.Interior.ColorIndex = 33
End If
Next Celda
End Sub
(Y si no fuese mucho pedir completar la macro con un autofiltro, mostrando el código buscando que se encuentran en las filas A2, A149 y A260).
Y por último luego de realizar los cambios en las dichas columnas, se presionará el botón “LIMPIA SELECCIÓN”, deberá borrar el color resaltado del código buscado, tanto de la columna A como la E (y si la macro tuviera el autofiltro también deberá ser borrado y volver a su estado normal). Adjunto macro de limpiar selección.
Sub Resetear2017()
Dim Celda As Range
Dim palabra As String
For Each Celda In Range("A2:A5000")
Celda.Characters(posicion, Len(palabra)).Font.Color = vbBlack
Celda.Interior.ColorIndex = 0
Next Celda
End Sub
1 respuesta
Te anexo la macro con lo siguiente:
- Quita el filtro
- Limpia los colores de la columna A y E
- Limpia lo que está en negritas
- Busca el código
-Pinta A y E
- Filtra la columna A por el código buscado
Sub BuscarTrabajador2017()
'Este macro busca ahora por Nombre
If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
u = Range("A" & Rows.Count).End(xlUp).Row
Range("A2:A" & u & ", E2:E" & u).Interior.ColorIndex = xlNone
Range("A2:A" & u).Font.Bold = False
palabra = InputBox("Buscar por Nombre3333...")
If palabra = "" Then Exit Sub
'
Set r = Columns("A")
Set b = r.Find(palabra, LookAt:=xlPart)
If Not b Is Nothing Then
Celda = b.Address
Do
Range("A" & b.Row & ", E" & b.Row).Interior.ColorIndex = 33
b.Characters(1, Len(palabra)).Font.FontStyle = "Negrita"
Set b = r.FindNext(b)
Loop While Not b Is Nothing And b.Address <> Celda
End If
If IsNumeric(palabra) Then palabra = Val(palabra)
ActiveSheet.Range("A1:Q" & u).AutoFilter Field:=1, Criteria1:=palabra
End SubLa segunda macro para limpiar:
Sub limpiar()
If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
u = Range("A" & Rows.Count).End(xlUp).Row
Range("A2:A" & u & ", E2:E" & u).Interior.ColorIndex = xlNone
Range("A2:A" & u).Font.Bold = False
End SubNOTA: En tu macro para limpiar, esta línea, no hace nada, ya que las variables posición y palabra están vacías
Celda.Characters(posicion, Len(palabra)).Font.Color = vbBlack
.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
.
Avísame cualquier duda
.
Buenas noches amigo Dante Amor, la macro quedo excelente, con las modificaciones echas, al pintar de color negrita el valor buscado, dentro del filtro.
¡Gracias!
