Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel amortissement

amortissement

18 réponses
Avatar
dracbi
bonsoir,

quelqu'un pourrait il m'aider =E0 trouver une fa=E7on plus ad=E9quate de
g=E9rer les amortissements d'immo en lin=E9aire et d=E9gressif.
Voici ce que j'ai en lin=E9aire mais c'est un peu long d=E9sol=E9 :(


Sub AmortLineaire()

'**************************************************************************=
******
'_________Ecrase les donn=E9es de la zone dans laquelle je vais
=E9crire_____________
'**************************************************************************=
******

Range("A10:Q1000").Clear


'**************************************************************************=
******
' ________________________________Mes
variables__________________________________
'**************************************************************************=
******

Dim NomImmo As String
Dim DateDebut As Date
Dim Duree As Integer
Dim Taux As Double
Dim PrixAcquisitionHT As Double
Dim annee As Integer
Dim i As Integer 'compteur permettant d'identifier la premiere et
derniere ligne


'**************************************************************************=
******
'____________ La valeur des variables se trouvent dans une feuille
______________
'**************************************************************************=
******

NomImmo =3D Range("C2")
DateDebut =3D Range("C3")
Duree =3D Range("C4")
Taux =3D 1 / Duree
Range("C6") =3D Taux
PrixAcquisitionHT =3D Range("C7")
annee =3D Year(DateDebut)

'**************************************************************************=
*****
'_______________________ En t=EAte du tableau =E0 cr=E9er
____________________________
'**************************************************************************=
*****

Range("A10").Value =3D "Rang"
Range("B10").Value =3D "Ann=E9e"
Range("C10").Value =3D "Periode"
Range("D10").Value =3D "VNC D=E9but Exercice"
Range("E10").Value =3D "Amort lin=E9aire"
Range("F10").Value =3D "JANV" 'amortissement de janvier
Range("G10").Value =3D "FEV" 'amortissement de fevrier
Range("H10").Value =3D "MARS" 'amortissement de mars
Range("I10").Value =3D "AVRIL" 'amortissement d' avril
Range("J10").Value =3D "MAI" 'amortissement de mai
Range("K10").Value =3D "JUIN" 'amortissement de juin
Range("L10").Value =3D "JUILL" 'amortissement de juillet
Range("M10").Value =3D "AOUT" 'amortissemet de aout
Range("N10").Value =3D "SEPT" 'amortissement de septembre
Range("O10").Value =3D "OCT" 'amortissement de octobre
Range("P10").Value =3D "NOV" 'amortissement de novembre
Range("Q10").Value =3D "DEC" 'amortissement de d=E9cembre

'**************************************************************************=
****
'____________________________________ Boucle
__________________________________
'**************************************************************************=
****

Range("A10").Select
For i =3D 1 To Duree + 1
ActiveCell.Offset(i).Interior.ColorIndex =3D 8
ActiveCell.Offset(i, 0) =3D i 'on d=E9finit le nombre de rang soit le
nombre de ligne utilis=E9

'pour g=E9rer le prorata de la premi=E8re ann=E9e d'amortissement
If ActiveCell.Offset(i, 0) =3D 1 Then
ActiveCell.Offset(i, 1) =3D annee
ActiveCell.Offset(i, 2) =3D DateDebut & " au 31/12/" & annee
ActiveCell.Offset(i, 3) =3D PrixAcquisitionHT
ActiveCell.Offset(i, 4) =3D PrixAcquisitionHT * Taux * (30 + 1 -
Day(DateDebut) + 30 * (12 - Month(DateDebut))) / 360 'annuit=E9 de la
pr=E9mi=E8re ann=E9e compl=E8te
If Month(DateDebut) =3D 1 Then
ActiveCell.Offset(i, 5) =3D PrixAcquisitionHT * Taux * (((30 + 1
- Day(DateDebut)) / 30) * 1 / 12)
ActiveCell.Offset(i, 6) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 7) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 8) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 9) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 10) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 11) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 12) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 13) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 14) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 15) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 16) =3D PrixAcquisitionHT * Taux * (1 / 12)
Else
If Month(DateDebut) =3D 2 Then
ActiveCell.Offset(i, 6) =3D PrixAcquisitionHT * Taux * (((30 + 1
- Day(DateDebut)) / 30) * 1 / 12)
ActiveCell.Offset(i, 7) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 8) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 9) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 10) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 11) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 12) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 13) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 14) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 15) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 16) =3D PrixAcquisitionHT * Taux * (1 / 12)
Else
If Month(DateDebut) =3D 3 Then
ActiveCell.Offset(i, 7) =3D PrixAcquisitionHT * Taux * (((30 + 1
- Day(DateDebut)) / 30) * 1 / 12)
ActiveCell.Offset(i, 8) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 9) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 10) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 11) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 12) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 13) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 14) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 15) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 16) =3D PrixAcquisitionHT * Taux * (1 / 12)
Else
If Month(DateDebut) =3D 4 Then
ActiveCell.Offset(i, 8) =3D PrixAcquisitionHT * Taux * (((30 + 1
- Day(DateDebut)) / 30) * 1 / 12)
ActiveCell.Offset(i, 9) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 10) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 11) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 12) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 13) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 14) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 15) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 16) =3D PrixAcquisitionHT * Taux * (1 / 12)
Else
If Month(DateDebut) =3D 5 Then
ActiveCell.Offset(i, 9) =3D PrixAcquisitionHT * Taux * (((30 + 1
- Day(DateDebut)) / 30) * 1 / 12)
ActiveCell.Offset(i, 10) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 11) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 12) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 13) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 14) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 15) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 16) =3D PrixAcquisitionHT * Taux * (1 / 12)
Else
If Month(DateDebut) =3D 6 Then
ActiveCell.Offset(i, 10) =3D PrixAcquisitionHT * Taux * (((30 +
1 - Day(DateDebut)) / 30) * 1 / 12)
ActiveCell.Offset(i, 11) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 12) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 13) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 14) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 15) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 16) =3D PrixAcquisitionHT * Taux * (1 / 12)
Else
If Month(DateDebut) =3D 7 Then
ActiveCell.Offset(i, 11) =3D PrixAcquisitionHT * Taux * (((30 +
1 - Day(DateDebut)) / 30) * 1 / 12)
ActiveCell.Offset(i, 12) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 13) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 14) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 15) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 16) =3D PrixAcquisitionHT * Taux * (1 / 12)
Else
If Month(DateDebut) =3D 8 Then
ActiveCell.Offset(i, 12) =3D PrixAcquisitionHT * Taux * (((30 +
1 - Day(DateDebut)) / 30) * 1 / 12)
ActiveCell.Offset(i, 13) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 14) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 15) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 16) =3D PrixAcquisitionHT * Taux * (1 / 12)
Else
If Month(DateDebut) =3D 9 Then
ActiveCell.Offset(i, 13) =3D PrixAcquisitionHT * Taux * (((30 +
1 - Day(DateDebut)) / 30) * 1 / 12)
ActiveCell.Offset(i, 14) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 15) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 16) =3D PrixAcquisitionHT * Taux * (1 / 12)
Else
If Month(DateDebut) =3D 10 Then
ActiveCell.Offset(i, 14) =3D PrixAcquisitionHT * Taux * (((30 +
1 - Day(DateDebut)) / 30) * 1 / 12)
ActiveCell.Offset(i, 15) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 16) =3D PrixAcquisitionHT * Taux * (1 / 12)
Else
If Month(DateDebut) =3D 11 Then
ActiveCell.Offset(i, 15) =3D PrixAcquisitionHT * Taux * (((30 +
1 - Day(DateDebut)) / 30) * 1 / 12)
ActiveCell.Offset(i, 16) =3D PrixAcquisitionHT * Taux * (1 / 12)
Else
If Month(DateDebut) =3D 12 Then
ActiveCell.Offset(i, 16) =3D PrixAcquisitionHT * Taux * (((30 +
1 - Day(DateDebut)) / 30) * 1 / 12)

End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
Else

'pour g=E9rer le prorata de la derni=E8re ann=E9e d'amortissement
If ActiveCell.Offset(i, 0) =3D Duree + 1 Then
ActiveCell.Offset(i, 1) =3D annee + i - 1
ActiveCell.Offset(i, 2) =3D "01/01/" & annee + i - 1 & " au " &
Day(DateDebut) & "/" & Month(DateDebut) & "/" & annee + i - 1
ActiveCell.Offset(i, 3) =3D ActiveCell.Offset(i - 1, 3).Value -
ActiveCell.Offset(i - 1, 4).Value
ActiveCell.Offset(i, 4) =3D ActiveCell.Offset(i, 3)

If Month(DateDebut) =3D 1 Then
ActiveCell.Offset(i, 5) =3D PrixAcquisitionHT * Taux * (((30 + 1
- Day(DateDebut)) / 30) * 1 / 12)
Else
If Month(DateDebut) =3D 2 Then
ActiveCell.Offset(i, 5) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 6) =3D PrixAcquisitionHT * Taux * (((30 + 1
- Day(DateDebut)) / 30) * 1 / 12)
Else
If Month(DateDebut) =3D 3 Then
ActiveCell.Offset(i, 5) =3D PrixAcquisitionHT * Taux * (((30 + 1
- Day(DateDebut)) / 30) * 1 / 12)
ActiveCell.Offset(i, 6) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 7) =3D PrixAcquisitionHT * Taux * (1 / 12)
Else
If Month(DateDebut) =3D 4 Then
ActiveCell.Offset(i, 5) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 6) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 7) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 8) =3D PrixAcquisitionHT * Taux * (((30 + 1
- Day(DateDebut)) / 30) * 1 / 12)
Else
If Month(DateDebut) =3D 5 Then
ActiveCell.Offset(i, 5) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 6) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 7) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 8) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 9) =3D PrixAcquisitionHT * Taux * (((30 + 1
- Day(DateDebut)) / 30) * 1 / 12)
Else
If Month(DateDebut) =3D 6 Then
ActiveCell.Offset(i, 5) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 6) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 7) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 8) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 9) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 10) =3D PrixAcquisitionHT * Taux * (((30 +
1 - Day(DateDebut)) / 30) * 1 / 12)
Else
If Month(DateDebut) =3D 7 Then
ActiveCell.Offset(i, 5) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 6) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 7) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 8) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 9) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 10) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 11) =3D PrixAcquisitionHT * Taux * (((30 +
1 - Day(DateDebut)) / 30) * 1 / 12)
Else
If Month(DateDebut) =3D 8 Then
ActiveCell.Offset(i, 5) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 6) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 7) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 8) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 9) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 10) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 11) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 12) =3D PrixAcquisitionHT * Taux * (((30 +
1 - Day(DateDebut)) / 30) * 1 / 12)
Else
If Month(DateDebut) =3D 9 Then
ActiveCell.Offset(i, 5) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 6) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 7) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 8) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 9) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 10) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 11) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 12) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 13) =3D PrixAcquisitionHT * Taux * (((30 +
1 - Day(DateDebut)) / 30) * 1 / 12)
Else
If Month(DateDebut) =3D 10 Then
ActiveCell.Offset(i, 5) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 6) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 7) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 8) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 9) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 10) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 11) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 12) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 13) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 14) =3D PrixAcquisitionHT * Taux * (((30 +
1 - Day(DateDebut)) / 30) * 1 / 12)
Else
If Month(DateDebut) =3D 11 Then
ctiveCell.Offset(i, 5) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 6) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 7) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 8) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 9) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 10) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 11) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 12) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 13) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 14) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 15) =3D PrixAcquisitionHT * Taux * (((30 +
1 - Day(DateDebut)) / 30) * 1 / 12)
Else
If Month(DateDebut) =3D 12 Then
ActiveCell.Offset(i, 5) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 6) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 7) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 8) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 9) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 10) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 11) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 12) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 13) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 14) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 15) =3D PrixAcquisitionHT * Taux * (1 / 12)
ActiveCell.Offset(i, 16) =3D PrixAcquisitionHT * Taux * (((30 +
1 - Day(DateDebut)) / 30) * 1 / 12)
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If

Else

'pour g=E9rer l'amortissement des ann=E9es compl=E8tes
If ActiveCell.Offset(i, 0) <> 1 Then
ActiveCell.Offset(i, 1) =3D annee + i - 1
ActiveCell.Offset(i, 2) =3D "01/01/" & annee + i - 1 & " au 31/12/"
& annee + i - 1
ActiveCell.Offset(i, 3) =3D ActiveCell.Offset(i - 1, 3).Value -
ActiveCell.Offset(i - 1, 4).Value
ActiveCell.Offset(i, 4) =3D PrixAcquisitionHT * Taux
ActiveCell.Offset(i, 5) =3D PrixAcquisitionHT * Taux * 1 / 12 'janv
ActiveCell.Offset(i, 6) =3D PrixAcquisitionHT * Taux * 1 / 12 'fev
ActiveCell.Offset(i, 7) =3D PrixAcquisitionHT * Taux * 1 / 12 'mars
ActiveCell.Offset(i, 8) =3D PrixAcquisitionHT * Taux * 1 / 12 'avr
ActiveCell.Offset(i, 9) =3D PrixAcquisitionHT * Taux * 1 / 12 'mai
ActiveCell.Offset(i, 10) =3D PrixAcquisitionHT * Taux * 1 / 12 'juin
ActiveCell.Offset(i, 11) =3D PrixAcquisitionHT * Taux * 1 / 12
'juill
ActiveCell.Offset(i, 12) =3D PrixAcquisitionHT * Taux * 1 / 12 'aout
ActiveCell.Offset(i, 13) =3D PrixAcquisitionHT * Taux * 1 / 12 'sept
ActiveCell.Offset(i, 14) =3D PrixAcquisitionHT * Taux * 1 / 12 'oct
ActiveCell.Offset(i, 15) =3D PrixAcquisitionHT * Taux * 1 / 12 'nov
ActiveCell.Offset(i, 16) =3D PrixAcquisitionHT * Taux * 1 / 12 'dec
End If
End If
End If
Next i

End Sub
Signaler un problème avec ce contenu

8 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
1 2
Avatar
dracbi
le fichier merci philippe

http://cjoint.com/?lcumcJgthM
Avatar
Philippe.R
Re,
Le code pourrait donc de venir, suite à 1ère modification :

Sub AmortLineaire()
'Modifié le 02/11/2008 par MPFE
'********************************************************************************
'_________Ecrase les données de la zone dans laquelle je vais
écrire_____________
'********************************************************************************

Range("A10:Q1000").Clear

'********************************************************************************
' ________________________________Mes
variables__________________________________
'********************************************************************************

Dim NomImmo As String
Dim DateDebut As Date
Dim Duree As Integer
Dim Taux As Double
Dim PrixAcquisitionHT As Double
Dim annee As Integer
Dim i As Integer 'compteur permettant d'identifier la premiere et derniere
ligne

'********************************************************************************
'____________ La valeur des variables se trouvent dans une feuille
______________
'********************************************************************************

NomImmo = Range("C2")
DateDebut = Range("C3")
Duree = Range("C4")
Taux = 1 / Duree
Range("C6") = Taux
PrixAcquisitionHT = Range("C7")
annee = Year(DateDebut)

'*******************************************************************************
'_______________________ En tête du tableau à créer
____________________________
'*******************************************************************************

Range("A10").Value = "Rang"
Range("B10").Value = "Année"
Range("C10").Value = "Periode"
Range("D10").Value = "VNC Début Exercice"
Range("E10").Value = "Amort linéaire"
Range("F10").Value = "JANV" 'amortissement de janvier
Range("G10").Value = "FEV" 'amortissement de fevrier
Range("H10").Value = "MARS" 'amortissement de mars
Range("I10").Value = "AVRIL" 'amortissement d' avril
Range("J10").Value = "MAI" 'amortissement de mai
Range("K10").Value = "JUIN" 'amortissement de juin
Range("L10").Value = "JUILL" 'amortissement de juillet
Range("M10").Value = "AOUT" 'amortissemet de aout
Range("N10").Value = "SEPT" 'amortissement de septembre
Range("O10").Value = "OCT" 'amortissement de octobre
Range("P10").Value = "NOV" 'amortissement de novembre
Range("Q10").Value = "DEC" 'amortissement de décembre

'******************************************************************************
'____________________________________ Boucle
__________________________________
'******************************************************************************

Range("A10").Select
For i = 1 To Duree + 1
'ActiveCell.Offset(i).Interior.ColorIndex = 8
ActiveCell.Offset(i, 0) = i 'on définit le nombre de rang soit le nombre de
ligne utilisé
j = Month(DateDebut) + 4
'pour gérer le prorata de la première année d'amortissement
If ActiveCell.Offset(i, 0) = 1 Then
ActiveCell.Offset(i, 1) = annee
ActiveCell.Offset(i, 2) = DateDebut & " au 31/12/" & annee
ActiveCell.Offset(i, 3) = PrixAcquisitionHT
ActiveCell.Offset(i, 4) = PrixAcquisitionHT * Taux * (30 + 1 _
- Day(DateDebut) + 30 * (12 - Month(DateDebut))) / 360 'annuité de
la prémière année complète
ActiveCell.Offset(i, j) = PrixAcquisitionHT * Taux * (((30 + 1 _
- Day(DateDebut)) / 30) * 1 / 12)
If j < 16 Then
For k = j + 1 To 16
ActiveCell.Offset(i, k) = PrixAcquisitionHT * Taux * (1 /
12)
Next k
End If

Else

'pour gérer le prorata de la dernière année d'amortissement
If ActiveCell.Offset(i, 0) = Duree + 1 Then
ActiveCell.Offset(i, 1) = annee + i - 1
ActiveCell.Offset(i, 2) = "01/01/" & annee + i - 1 & " au " &
Day(DateDebut) & "/" & Month(DateDebut) & "/" & annee + i - 1
ActiveCell.Offset(i, 3) = ActiveCell.Offset(i - 1, 3).Value -
ActiveCell.Offset(i - 1, 4).Value
ActiveCell.Offset(i, 4) = ActiveCell.Offset(i, 3)
ActiveCell.Offset(i, j) = PrixAcquisitionHT * Taux * (((30 + 1 _
- Day(DateDebut)) / 30) * 1 / 12)
For k = 5 To j - 1
ActiveCell.Offset(i, k) = PrixAcquisitionHT * Taux * (1 / 12)
Next k

Else

'pour gérer l'amortissement des années complètes
If ActiveCell.Offset(i, 0) <> 1 Then
ActiveCell.Offset(i, 1) = annee + i - 1
ActiveCell.Offset(i, 2) = "01/01/" & annee + i - 1 & " au 31/12/" &
annee + i - 1
ActiveCell.Offset(i, 3) = ActiveCell.Offset(i - 1, 3).Value -
ActiveCell.Offset(i - 1, 4).Value
ActiveCell.Offset(i, 4) = PrixAcquisitionHT * Taux
ActiveCell.Offset(i, 5) = PrixAcquisitionHT * Taux * 1 / 12 'janv
ActiveCell.Offset(i, 6) = PrixAcquisitionHT * Taux * 1 / 12 'fev
ActiveCell.Offset(i, 7) = PrixAcquisitionHT * Taux * 1 / 12 'mars
ActiveCell.Offset(i, 8) = PrixAcquisitionHT * Taux * 1 / 12 'avr
ActiveCell.Offset(i, 9) = PrixAcquisitionHT * Taux * 1 / 12 'mai
ActiveCell.Offset(i, 10) = PrixAcquisitionHT * Taux * 1 / 12 'juin
ActiveCell.Offset(i, 11) = PrixAcquisitionHT * Taux * 1 / 12 'juill
ActiveCell.Offset(i, 12) = PrixAcquisitionHT * Taux * 1 / 12 'aout
ActiveCell.Offset(i, 13) = PrixAcquisitionHT * Taux * 1 / 12 'sept
ActiveCell.Offset(i, 14) = PrixAcquisitionHT * Taux * 1 / 12 'oct
ActiveCell.Offset(i, 15) = PrixAcquisitionHT * Taux * 1 / 12 'nov
ActiveCell.Offset(i, 16) = PrixAcquisitionHT * Taux * 1 / 12 'dec
End If
End If
End If
Next i

End Sub

testé sur ce fichier :
http://cjoint.com/?lcu5E3vqRm
--
Avec plaisir
http://dj.joss.free.fr/trombine.htm
http://jacxl.free.fr/mpfe/trombino.html
Philippe.R
Pour se connecter au forum :
http://www.excelabo.net/mpfe/connexion.php
News://news.microsoft.com/microsoft.public.fr.excel
a écrit dans le message de
news:
le fichier merci philippe

http://cjoint.com/?lcumcJgthM


Avatar
dracbi
Impeccable un grand merci je vais tacher de comprendre le code
maintenant :)
Avatar
Modeste
Bonsour® FxM avec ferveur ;o))) vous nous disiez :

Bonjour,



tiens !!! le retour....
;o)))

ou bien c'est comme les champignons...
j'en ai trouvé un autre aussi et non des moindres ...

Dernier signe de vie le 31 octobre 2008 à 19:12:49 sur http://www.vbfrance.com/
http://www.vbfrance.com/codes/AMORTISSEMENT-EMPRUNTS_48348.aspx

--
@+
;o)))
Avatar
d.sundow
Bonjour,

L'outil proposé ci-dessus par Philippe R. m'intéresse beaucoup :

http://cjoint.com/?lcu5E3vqRm

Serait-il toutefois possible qu'il calcul avec un arrondi à l'unité ?

Et Nirvana ultime un ratraprage sur le dernier amortissement pour la
compenser l'éventuel écart dû à l'arrondi.

Merci d'avance - Sundow
Avatar
dracbi
On 3 nov, 10:53, wrote:
Bonjour,

L'outil proposé ci-dessus par Philippe R. m'intéresse beaucoup :

http://cjoint.com/?lcu5E3vqRm

Serait-il toutefois possible qu'il calcul avec un arrondi à l'unité ?

Et Nirvana ultime un ratraprage sur le dernier amortissement pour la
compenser l'éventuel écart dû à l'arrondi.

Merci d'avance - Sundow



bonjour oui c possible je le met à jour avec du degressif et une
gestion sous forme de liste des immo ;)
Avatar
d.sundow
Bonjour,

Super n'hésite pas à partager le fruit de tes recherches. ça fera des
heureux! :)

Je guette - @+ - Sundow
Avatar
FxM
Philippe.R a écrit :
Bonjour FxM,
Ca fait plaisir de te voir par ici...



Hello,

Plaisir partagé !
Mes occupations actuelles et futures font que je ne participe plus
beaucoup, même si je tache de lire le plus possible.

@+ et bises aux filles
FxM
1 2