Elsa hola¡

Ya me da pena molestarte tanto.
Pero sigo inventándome problemas,
ahora estoy tratando de usar una de las macros de tu gran manual.
!(Publicidad para quien leea esto)¡.
Es la de buscarvs que pinta las celdas encontradas.
Trabaja perfecto pero me gustaría que sumara las celdas a la izquierda de las PINTADAS, una columna a la izquierda y el total lo necesito en celda "IV2", ademas de que regresara el color negro a las celdas antes pintadas, cuando escoja otro numero a buscar.
¿Puedes hacerme este otro favor?.
Mil gracias de nuevo.
ro1ber2to.
Sub BuscarVs()
Range("IV1").Value = InputBox("!INGRESA EL NUMERO DE SEMANA QUE QUIERES VER¡")
celdabusq = Range("IV1").Value
'variables para ser configuradas por el usuario:
celdabusq = "IV1" 'celda donde está el dato a buscar
deHojaC = "PAGADOS" ' Hoja donde está la celda anterior
RangoBusq = "k2:IG301" 'Rango donde debe efectuarse la búsqueda
deHojaR = "PAGADOS" ' Hoja donde está el rango de búsqueda
'se establece el valor a buscar
aBuscar = Sheets(deHojaC).Range(celdabusq).Value
'vamos a la hoja donde se realizará la búsqueda
Sheets(deHojaR).Select
Range("IV1").Select
'significa: con el rango asignado
With Worksheets(deHojaR).Range(RangoBusq)
'se realiza la primer búsqueda creando un objeto resultante llamado 'c'
Set c = .Find(aBuscar, LookIn:=xlValues)
'si la búsqueda fue exitosa se guarda la dirección
If Not c Is Nothing Then
PrimCoinc = c.Address
'comienza el bucle de lo que debe realizarse en cada resultado encontrado
'en este ejemplo solo se da color a la celda
Do
c.Interior.ColorIndex = 39
'se realiza la búsqueda siguiente
Set c = .FindNext(c)
'el bucle continúa mientras se encuentre coincidencias y NO sea la primer celda encontrada
Loop While Not c Is Nothing And c.Address <> PrimCoinc
'se selecciona la primer celda encontrada (opcional)
Range(PrimCoinc).Select
Else
'devuelve mensaje si la búsqueda no fue exitosa
MsgBox "El valor " & aBuscar & " NO fue encontrado en el rango indicado", vbInformation, "Resultado"
End If
End With
End Sub

1 Respuesta

Respuesta
1
Estuve un poco atareada... pero aquí va lo que creo necesitas. Lee cada comentario ya que he hecho cambios sobre la misma rutina. Además te agregué la que borra colores que la podes colocar en el mismo módulo.
Saludos
Elsa
Sub BuscarVs()
Dim total As Double
'macro de Elsamatilde, ajustada por Roberto :)
'ejecuta la rutina que quita el color anterior
QuitaColor
Range("IV1").Value = InputBox("!INGRESA EL NUMERO DE SEMANA QUE QUIERES VER¡")
'AT:la siguiente instrucción está de más
'celdabusq = Range("IV1").Value
'variables para ser configuradas por el usuario:
'AT: si ambas hojas serán las mismas podés utilizar una sola variable
celdabusq = "IV1" 'celda donde está el dato a buscar
deHojaC = "PAGADOS" ' Hoja donde está la celda anterior
RangoBusq = "k2:IG301" 'Rango donde debe efectuarse la búsqueda
deHojaR = "PAGADOS" ' Hoja donde está el rango de búsqueda
'se establece el valor a buscar
aBuscar = Sheets(deHojaC).Range(celdabusq).Value
'vamos a la hoja donde se realizará la búsqueda
Sheets(deHojaR).Select
Range("IV1").Select
'significa: con el rango asignado
With Worksheets(deHojaR).Range(RangoBusq)
'se realiza la primer búsqueda creando un objeto resultante llamado 'c'
Set c = .Find(aBuscar, LookIn:=xlValues)
'si la búsqueda fue exitosa se guarda la dirección
If Not c Is Nothing Then
PrimCoinc = c.Address
'comienza el bucle de lo que debe realizarse en cada resultado encontrado
'AT: en este ejemplo se da color a la celda y se suma el contenido de la col anterior
Do
c.Interior.ColorIndex = 39
total = c.Offset(0, -1).Value + total
'se realiza la búsqueda siguiente
Set c = .FindNext(c)
'el bucle continúa mientras se encuentre coincidencias y NO sea la primer celda encontrada
Loop While Not c Is Nothing And c.Address <> PrimCoinc
'AT: se vuelca el total en la celda
Range("IV2").Value = total
Else
'devuelve mensaje si la búsqueda no fue exitosa
MsgBox "El valor " & aBuscar & " NO fue encontrado en el rango indicado", vbInformation, "Resultado"
End If
End With
End Sub
Sub QuitaColor()
' Macro grabada el 01/07/2005 por Elsamatilde
RangoBusq = "k2:IG301" 'Rango donde debe efectuarse la búsqueda
deHojaC = "PAGADOS" ' Hoja donde está la celda anterior
Sheets(deHojaC).Range(RangoBusq).Select
Selection.Interior.ColorIndex = 1 'color negro
End Sub

Añade tu respuesta

Haz clic para o
El autor de la pregunta ya no la sigue por lo que es posible que no reciba tu respuesta.

Más respuestas relacionadas