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)

Respuesta
2

  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

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas