Ver Mensaje Individual
  #8 (permalink)  
Antiguo 18/01/2010, 09:32
Avatar de ceSharp
ceSharp
 
Fecha de Ingreso: octubre-2008
Ubicación: Madrid
Mensajes: 495
Antigüedad: 15 años, 6 meses
Puntos: 66
Respuesta: Macro que busque y resalte (color de relleno)

wgalvis, wgalvis....

ay que me hiciste estrujarme el cerebro más de la cuenta el viernes... claro que por mi culpa, por no mirar la fecha del post... pero bueno, siempre me gusta investigar y, sobre todo, aprender, y sin duda con la tarea del viernes aprendí algunas cosillas.

bueno, en cuanto a tu tarea ya la tengo lista. no sé lo puesto que estás en excel. por si acaso te lo indico paso a paso:

1) abres tu libro excel
2) pulsa Alt+F11 para abrir el código VBA
3) click derecho en 'Microsoft Excel Objetos' --> Insertar --> Módulo
4) pega todo esto en el módulo creado
'-------------------------------------------------
Dim hojas As Integer
Dim algunaCoincidencia As Boolean
Dim fila As Integer
Dim siguienteFila As Integer
Dim sede As String
Dim i As Integer
Sub buscarSede()

sede = InputBox("Introduzca la sede:")
hojas = ThisWorkbook.Sheets.Count

'buscamos en todas las hojas, menos en la primera que es donde
'van los resultados
For i = 2 To hojas
Sheets("Hoja" & i).Select
Call encontrarSede(i)

Next

End Sub

Sub encontrarSede(numHoja As Integer)
On Error GoTo noEncontrado

Dim celdaX As String

Cells.Find(what:=sede, after:=ActiveCell, LookIn:=xlFormulas, lookat:=xlWhole, _
searchorder:=xlByRows, searchdirection:=xlNext, MatchCase:=False, _
searchformat:=False).Activate

'como ha encontrado uno ya tenemos alguna coincidencia
algunaCoincidencia = True

celda1 = ActiveCell.Address
celda2 = 0

Do While celda2 <> celda1
If celdaX = "" Then
celdaX = celda1
Else
celdaX = celda2
End If

inicio = InStr(ActiveCell, valor)
fila = ActiveCell.Row
Rows(fila & ":" & fila).Select
'copiamos la fila entera
Selection.Copy
'y nos vamos a la hoja1 para pegar el resultado
Call pegarResultado
Sheets("Hoja" & numHoja).Select
Range(celdaX).Select
Cells.FindNext(after:=ActiveCell).Activate
celda2 = ActiveCell.Address
Loop

Exit Sub

noEncontrado:
'comprobamos si ya hemos visto todas las hojas
If i = hojas And algunaCoincidencia = False Then
MsgBox ("No se han encontrado coincidencias")
Else
Exit Sub
End If

End Sub
Sub pegarResultado()

If siguienteFila = 0 Then
siguienteFila = 4
End If
Dim salir As Boolean

'nos situamos en la hoja1 en la primera fila donde pegar resultados
Hoja1.Select
Do
If Range("A" & siguienteFila) = "" Then
Range("A" & siguienteFila).Select
Selection.PasteSpecial
salir = True
Else
siguienteFila = siguienteFila + 1
End If
Loop Until salir = True

End Sub
'---------------------------------------------------
5) crea un botón en tu Hoja1
6) click derecho sobre el botón --> Asignar Macro
7) en la siguiente ventana selecciona la macro 'buscarSede'

si no me he equivocado yo y tú has seguido estos pasos correctamente, al escribir el nombre de una sede en la ventana que sale al pulsar el botón debería de hacer lo que tu pides.

si tienes problemas para implementarlo ya sabes donde estamos.

salu2