Préstamo Blindado automático

Descargar el fichero: blindado.xlsm

Modificamos el préstamo blindado para conseguir automatizarlo y que no tengamos que hacer dos cuadros de amortización. Los cálculos los realiza una macro que al detectar el último periodo lo ajusta y finaliza el cuadro. Se detecta el último mes cuando el capital vivo se hace negativo, y se ajusta siguiendo los tres pasos que se mostraron en el POST que explicaba el préstamo blindado resuelto manualmente. Este es el post del préstamo blindado manual:

Préstamo blindado manual

En color amarillo se han puesto los datos: Principal, Diferencial y Euribor. Tras modificar alguno de ellos se ha de pulsar el botón Recalcular.

En color naranja se ha puesto la celda de la mensualidad que quiere pagar el cliente. Al poner el importe en esta celda y validarla, por ejemplo, pulsando INTRO, se lanza, de forma automática, la macro que confecciona el cuadro de amortización. El valor en euros que podemos poner en esta celda esta limitado. No podemos admitir que el cliente pague una cantidad que no llegue a amortizar el principal del préstamo. En este caso se ha limitado a 50 años la duración máxima admisible. Luego la mensualidad mínima admisible esta condicionada por esos 50 años máximos, por el principal, por el diferencial y por el Euribor estimado para esos 50 años.

La macro que calcula el cuadro de amortización toma los datos (celdas amarillas) y calcula matricialmente las columnas del cuadro, ajusta la última fila y deja los valores calculados en el cuadro. Es importante no mover celdas, o bien no insertar o suprimir, filas o columnas, ya que la macro perdería las referencias de la hoja.

Codigo:

Option Explicit
Sub blindado_auto()
Dim C(600) As Double 'capital vivo
Dim E 'Euribor anual
Dim Tmensu(600) As Double
Dim Dif As Double
Dim j As Long
Dim x As Long 'último mes
Dim mes(600) As Long 'max 50 años
Dim anyo(600) As Long
Dim mensu(600) As Double
Dim mensualidad As Double
Dim I(600) As Double
Dim A(600) As Double
Dim m(600) As Double
limpia_filas
E = [L14:L63] 'toma 50 Euribor anuales
C(0) = [c6] 'principal
Dif = [C10] 'diferencial
mes(0) = 0
anyo(0) = 0
mensualidad = [F8]
For j = 1 To 600
mes(j) = j
anyo(j) = Int(mes(j - 1) / 12) + 1
Tmensu(j) = (E(anyo(j), 1) + Dif) / 12
mensu(j) = mensualidad
I(j) = C(j - 1) * Tmensu(j)
A(j) = mensu(j) - I(j)
C(j) = C(j - 1) - A(j)
m(j) = m(j - 1) + A(j)
If j = 600 Then MsgBox ("Se superan los 600 meses." _
& Chr(10) & "Incremente la mensualidad"): End
If C(j) < 0 Then
x = j 'utimo mes
A(j) = C(j - 1)
mensu(j) = I(j) + A(j)
C(j) = C(j - 1) - A(j)
Exit For
End If
Next j
For j = 0 To x
Cells(j + 14, "B") = mes(j)
Cells(j + 14, "C") = anyo(j)
Cells(j + 14, "D") = Tmensu(j)
Cells(j + 14, "E") = mensu(j)
Cells(j + 14, "F") = I(j)
Cells(j + 14, "G") = A(j)
Cells(j + 14, "H") = C(j)
Cells(j + 14, "I") = m(j)
Next j
formatos
limpia_celdas
End Sub
Sub limpia_filas()
Range("B16:I614").Clear
Range("A1").Select
End Sub
Sub limpia_celdas()
Range("D14:G14,I14").Select
Range("I14").Activate
Selection.ClearContents
Range("A1").Select
End Sub
Sub formatos()
Range("B15:I15").Copy
Range("B15").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.PasteSpecial Paste:=xlPasteFormats
Range("A1").Select
Application.CutCopyMode = False
Range("a1").Select
End Sub