Una macro o fórmula que me permita saber cuanto voy a cobrar en la semana por un(os) contrato(s) y que los despliegue
Quisiera ver si me pueden ayudar, tengo una matriz que contiene los siguientes datos en excel:
Hoja 1: Datos del (los) Contrato(s)
Columna A1: Numero de Contrato
Columna B1: Plazo del Contrato (meses)
Columna C1: Fecha de Inicio del Contrato
Columna D1: Fecha Fin del Contrato
Columna E1: Importe a cobrar por mes
Columna F1: Numero de semana en que vence la primera fecha de vencimiento 1 er mes)
Columna G... Q1: Numero de semana en que vencen las fechas subsiguientes del contrato (no pudiendo exceder de 12 fechas)
A2(numero de Contrato): 1
B2 (plazo): 3 (=SIFECHA(C2,D2,"m")
C2 (fecha de Inicio): 14/01/2016
D2 (Fecha de Vencimiento): 14/04/2013
E2 (Monto Mensual): 1,000
F2 (Numero de Semana de Vencimiento del primer mes de pago): 8 (=SI(FECHA.MES($B2,F$1)>$C2,0,NUM.DE.SEMANA(FECHA.MES($B2,F$1),1)), las demás columnas calculan las semanas subsiguiente de acuerdo a los vencimientos mensuales no pudiendo exceder 12 pagos.
Hoja 2. (Ejemplo(s) que requiero desplegar)
1 Respuesta
H o l a : Te anexo la macro. Crea un botón en la hoja2 y asigna la macro al botón.
Sub Contratos()
'Por.Dante Amor
Set h1 = Sheets("Hoja1")
Set h2 = Sheets("Hoja2")
'
j = 7
u = h2.Range("A" & Rows.Count).End(xlUp).Row
If u < j Then u = j
h2.Range("A7:B" & u).ClearContents
h2.Range("B4") = 0
año = h2.Range("B2").Value
num = h2.Range("B3").Value
If año = "" Or Not IsNumeric(año) Then
MsgBox "Captura un año válido"
Exit Sub
End If
If num = "" Or Not IsNumeric(num) Then
MsgBox "Captura una semana válida"
Exit Sub
End If
'
u = h1.Range("A" & Rows.Count).End(xlUp).Row
Set r = h1.Range("F2:Q" & u)
Set b = r.Find(num, lookat:=xlWhole)
If Not b Is Nothing Then
celda = b.Address
Do
'detalle
If Year(h1.Cells(b.Row, "C")) = año Then
h2.Cells(j, "A") = h1.Cells(b.Row, "A").Value
h2.Cells(j, "B") = h1.Cells(b.Row, "E").Value
h2.Range("B4").Value = h2.Range("B4").Value + h1.Cells(b.Row, "E").Value
j = j + 1
End If
Set b = r.FindNext(b)
Loop While Not b Is Nothing And b.Address <> celda
End If
End Sub'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
Hola Dante, gracias por tu respuesta, ya pegue el botón y le asigne la macro, sin embargo al correrla no esta ejecutándose nada, ¿hay algo más que tenga que hacer?
¿Tienes activadas las macros en tu hoja de excel?
¿Tienes la información tal y como la pusiste en tus ejemplos?
Envíame tu archivo con la macro para revisarlo.
Mi correo [email protected]
En el asunto del correo escribe tu nombre de usuario “eherrerias” y el título de esta pregunta.
Ya esta enviado el archivo gracias.
Revisa mi correo, porque no me ha llegado.
Ya lo volví a mandar Dante
Te anexo la macro actualizada
Sub Contratos()
'Por.Dante Amor
Set h1 = Sheets("Hoja1")
Set h2 = Sheets("Hoja2")
'
j = 7
u = h2.Range("A" & Rows.Count).End(xlUp).Row
If u < j Then u = j
h2.Range("A7:B" & u).ClearContents
h2.Range("B4") = 0
año = h2.Range("B2").Value
num = h2.Range("B3").Value
If año = "" Or Not IsNumeric(año) Then
MsgBox "Captura un año válido"
Exit Sub
End If
If num = "" Or Not IsNumeric(num) Then
MsgBox "Captura una semana válida"
Exit Sub
End If
'
u = h1.Range("A" & Rows.Count).End(xlUp).Row
Set r = h1.Range("F2:Q" & u)
Set b = r.Find(num, lookat:=xlWhole, LookIn:=xlValues)
If Not b Is Nothing Then
celda = b.Address
Do
'detalle
If Year(h1.Cells(b.Row, "C")) = año Then
h2.Cells(j, "A") = h1.Cells(b.Row, "A").Value
h2.Cells(j, "B") = h1.Cells(b.Row, "E").Value
h2.Range("B4").Value = h2.Range("B4").Value + h1.Cells(b.Row, "E").Value
j = j + 1
End If
Set b = r.FindNext(b)
Loop While Not b Is Nothing And b.Address <> celda
End If
End Sub'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
Te mande un correo nuevo, el año se debe de calcular sobre la fecha de vencimiento.
Saludos
Entonces la macro funciona bien
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
