Thanks to visit codestin.com
Credit goes to www.scribd.com

Scribd
Upload
6 views3 pages

Code Programmation

The document contains a VBA macro that distributes project costs across years based on project duration and delays. It reads data from an Excel worksheet, identifies the relevant years, and allocates costs accordingly. The macro concludes with a message indicating successful completion of the distribution process.

Uploaded by

Youssef Salam
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as TXT, PDF, TXT or read online on Scribd
6 views3 pages

Code Programmation

The document contains a VBA macro that distributes project costs across years based on project duration and delays. It reads data from an Excel worksheet, identifies the relevant years, and allocates costs accordingly. The macro concludes with a message indicating successful completion of the distribution process.

Uploaded by

Youssef Salam
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as TXT, PDF, TXT or read online on Scribd
You are on page 1/ 3

Sub RépartirCoûtProjetsParAnnée()

Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets(1)

Dim lastRow As Long


lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

Dim projets(), couts(), delais(), programmations()


projets = ws.Range("A2:A" & lastRow)
couts = ws.Range("F2:F" & lastRow)
delais = ws.Range("R2:R" & lastRow)
programmations = ws.Range("S2:S" & lastRow)

Dim anneesDict As Object


Set anneesDict = CreateObject("Scripting.Dictionary")

Dim i As Long
Dim prog As String, debut As Integer, fin As Integer, cout As Double, delai As
Integer
Dim y As Integer, dureeProg As Integer

' Identifier les années


For i = 1 To UBound(projets)
prog = Trim(programmations(i, 1))
If Len(prog) = 4 And IsNumeric(prog) Then
debut = CInt(prog)
delai = Val(delais(i, 1))
fin = debut + Int(delai / 12)
For y = debut To fin + 1
If Not anneesDict.exists(y) Then anneesDict.Add y, Nothing
Next y
ElseIf Len(prog) = 9 And InStr(prog, "-") > 0 Then
debut = CInt(Left(prog, 4))
fin = CInt(Right(prog, 4))
dureeProg = fin - debut + 1
If dureeProg = 2 Then
For y = debut To debut + 2
If Not anneesDict.exists(y) Then anneesDict.Add y, Nothing
Next y
ElseIf dureeProg = 3 Then
For y = debut To debut + 3
If Not anneesDict.exists(y) Then anneesDict.Add y, Nothing
Next y
ElseIf dureeProg = 4 Then
For y = debut To debut + 4
If Not anneesDict.exists(y) Then anneesDict.Add y, Nothing
Next y
ElseIf dureeProg = 5 Then
For y = debut To debut + 5
If Not anneesDict.exists(y) Then anneesDict.Add y, Nothing
Next y
ElseIf dureeProg = 6 Then
For y = debut To debut + 6
If Not anneesDict.exists(y) Then anneesDict.Add y, Nothing
Next y
End If
End If
Next i
' Colonnes années
Dim baseCol As Long: baseCol = 20
Dim sortedYears() As Variant
sortedYears = SortKeys(anneesDict.keys)
Dim yearCols As Object
Set yearCols = CreateObject("Scripting.Dictionary")

For i = 0 To UBound(sortedYears)
ws.Cells(1, baseCol + i).Value = sortedYears(i)
yearCols.Add sortedYears(i), baseCol + i
Next i

' Répartition
For i = 1 To UBound(projets)
prog = Trim(programmations(i, 1))
cout = couts(i, 1)
delai = Val(delais(i, 1))

If Len(prog) = 4 And IsNumeric(prog) Then


debut = CInt(prog)
fin = debut + Int(delai / 12)
Dim totalYears As Integer
totalYears = fin - debut + 1
If totalYears > 0 Then
Dim montantAnnuel As Double
montantAnnuel = cout * 0.9 / totalYears
For y = debut To fin
ws.Cells(i + 1, yearCols(y)).Value = Round(montantAnnuel, 2)
Next y
ws.Cells(i + 1, yearCols(fin + 1)).Value = Round(cout * 0.1, 2)
End If
ElseIf Len(prog) = 9 And InStr(prog, "-") > 0 Then
debut = CInt(Left(prog, 4))
fin = CInt(Right(prog, 4))
dureeProg = fin - debut + 1
If dureeProg = 2 Then
ws.Cells(i + 1, yearCols(debut)).Value = Round(cout * 0.4, 2)
ws.Cells(i + 1, yearCols(debut + 1)).Value = Round(cout * 0.5, 2)
ws.Cells(i + 1, yearCols(debut + 2)).Value = Round(cout * 0.1, 2)
ElseIf dureeProg = 3 Then
ws.Cells(i + 1, yearCols(debut)).Value = Round(cout * 0.3, 2)
ws.Cells(i + 1, yearCols(debut + 1)).Value = Round(cout * 0.4, 2)
ws.Cells(i + 1, yearCols(debut + 2)).Value = Round(cout * 0.2, 2)
ws.Cells(i + 1, yearCols(debut + 3)).Value = Round(cout * 0.1, 2)
ElseIf dureeProg = 4 Then
ws.Cells(i + 1, yearCols(debut)).Value = Round(cout * 0.2, 2)
ws.Cells(i + 1, yearCols(debut + 1)).Value = Round(cout * 0.3, 2)
ws.Cells(i + 1, yearCols(debut + 2)).Value = Round(cout * 0.2, 2)
ws.Cells(i + 1, yearCols(debut + 3)).Value = Round(cout * 0.2, 2)
ws.Cells(i + 1, yearCols(debut + 4)).Value = Round(cout * 0.1, 2)
ElseIf dureeProg = 5 Then
ws.Cells(i + 1, yearCols(debut)).Value = Round(cout * 0.15, 2)
ws.Cells(i + 1, yearCols(debut + 1)).Value = Round(cout * 0.25, 2)
ws.Cells(i + 1, yearCols(debut + 2)).Value = Round(cout * 0.25, 2)
ws.Cells(i + 1, yearCols(debut + 3)).Value = Round(cout * 0.15, 2)
ws.Cells(i + 1, yearCols(debut + 4)).Value = Round(cout * 0.1, 2)
ws.Cells(i + 1, yearCols(debut + 5)).Value = Round(cout * 0.1, 2)
ElseIf dureeProg = 6 Then
ws.Cells(i + 1, yearCols(debut)).Value = Round(cout * 0.15, 2)
ws.Cells(i + 1, yearCols(debut + 1)).Value = Round(cout * 0.2, 2)
ws.Cells(i + 1, yearCols(debut + 2)).Value = Round(cout * 0.2, 2)
ws.Cells(i + 1, yearCols(debut + 3)).Value = Round(cout * 0.15, 2)
ws.Cells(i + 1, yearCols(debut + 4)).Value = Round(cout * 0.1, 2)
ws.Cells(i + 1, yearCols(debut + 5)).Value = Round(cout * 0.1, 2)
ws.Cells(i + 1, yearCols(debut + 6)).Value = Round(cout * 0.1, 2)

End If
End If
Next i

MsgBox "Répartition terminée avec succès."


End Sub

' Fonction de tri des clés


Function SortKeys(keys As Variant) As Variant
Dim i As Long, j As Long, temp As Variant
For i = LBound(keys) To UBound(keys) - 1
For j = i + 1 To UBound(keys)
If keys(i) > keys(j) Then
temp = keys(i)
keys(i) = keys(j)
keys(j) = temp
End If
Next j
Next i
SortKeys = keys
End Function

You might also like