Buscar en rango de celdas, monto y restar el máximo
De nuevo por aquí.
Esta vez si tengo un serio problema que me han dado. Voy a tratar de explicar lo mejor que pueda:
Tengo estas celdas, A, B y C
FECHA NOMBRE MONTO 01/01/2016 AA 3600 01/01/2016 BB 2800 03/01/2016 CC 3500 05/01/2016 DD 3900
necesito un bucle que busque en la columna C un monto superior de 3,500, si lo encuentra, que inserte una fila debajo y que haga lo siguiente:
1. En la columna A que me ponga una fecha distinta a la original, puede ser un día mas.
2. En la columna B que me ponga el mismo nombre de la celda encontrada.
3. Que ingrese el monto diferencial de la celda con problemas
Resumiendo, debería de quedar así:
FECHA NOMBRE MONTO 01/01/2016 AA 3500 02/01/2016 AA 100 01/01/2016 BB 2800 03/01/2016 CC 3500 05/01/2016 DD 3500 06/01/2016 DD 400
1 respuesta
H o l a:
Te anexo la macro.
Cambia en la macro "monto" por el nombre de tu hoja que tiene los datos. Crea una hoja y le pones por nombre "resultado".
Ejecuta la macro los resultados estarán en la hoja "resultado".
Sub RevisarMontos()
'Por.Dante Amor
Set h1 = Sheets("monto")
Set h2 = Sheets("resultado")
h2.Cells.ClearContents
h1.Rows(1).Copy h2.Rows(1)
j = 2
wmax = 3500
For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
h1.Rows(i).Copy h2.Rows(j)
j = j + 1
If h1.Cells(i, "C") > wmax Then
h2.Cells(j, "A") = h1.Cells(i, "A") + 1
h2.Cells(j, "B") = h1.Cells(i, "B")
h2.Cells(j, "C") = h1.Cells(i, "C") - wmax
j = j + 1
End If
Next
MsgBox "Fin"
End Sub':) ':)
Gracias amigo Dante, pero quería pedirte dos cosas:
1. La macro deja intacta el valor de la celda con el monto mayor, y debería de reemplazarlo con 3,500, así como te muestro en al segunda figura.
2. en la hoja que tengo esos datos, también tengo otros datos, por lo que me gustaría que solo busque en el rango A:C y copie ese rango especifico.
Saludos
La hoja de datos va a quedar intacta.
En la hoja "resultados" verás los nuevos registros, tal y como pusiste la imagen con el resultado, pero si tienes problemas con la macro, envíame tu archivo con mi macro y reviso tus datos.
Mi correo [email protected]
En el asunto del correo escribe tu nombre de usuario “Cpc Julio Pinedo Reategui” y el título de esta pregunta.
H o l a:
Te anexo la macro actualizada
Sub RevisarMontos()
'Por.Dante Amor
Set h1 = Sheets("monto")
Set h2 = Sheets("resultado")
h2.Cells.ClearContents
h1.Rows(1).Copy h2.Rows(1)
j = 2
wmax = 3500
For i = 2 To h1.Range("A" & Rows.Count).End(xlUp).Row
h1.Rows(i).Copy h2.Rows(j)
j = j + 1
If h1.Cells(i, "C") > wmax Then
h2.Cells(j, "A") = h1.Cells(i, "A") + 1
h2.Cells(j, "B") = h1.Cells(i, "B")
h2.Cells(j, "C") = h1.Cells(i, "C") - wmax
h2.Cells(j - 1, "C") = h2.Cells(j - 1, "C") - h2.Cells(j, "C")
j = j + 1
End If
Next
h2.Select
MsgBox "Fin"
End Sub':) S a l u d o s . D a n t e A m o r ':) Si es lo que necesitas. Recuerda valorar la respuesta. G r a c i a s.
