Sub Macro1()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim DD As Date 'déclare la variable DD(Date du Début)
Dim DF As Date 'déclare la variable DF (Date de Fin)
Dim D As Date 'déclare la variable D (Date)
Dim AD As Integer 'déclare la variable AD (Année du Début)
Dim AF As Integer 'déclare la variable AF (Année de Fin)
Dim NL As Integer 'déclare la variable NL (Nombre de Lignes)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim TF() As Variant 'déclare la variable TF (Tableau Final)
Dim COL As Integer 'déclare la variable COL (COLonne)
Dim LI As Integer 'déclare la variable LI (LIgne)
Dim N As Integer 'déclare la variable N (Nombre)
Dim T As Double 'déclare la variable T (Total)
Dim PL As Range 'déclare la variable PL (Plage)
Set O = Worksheets("Planilha1") 'définit l'onglet O
O.Range("B67").CurrentRegion.Clear 'efface d'eventuelles anciennes données
TV = O.Range("A4").CurrentRegion 'définit le tableau des valeurs
DD = DateSerial(Year(O.Range("ini")), Month(O.Range("ini")), Day(O.Range("ini"))) 'définit la date de debut DD
DF = DateSerial(Year(O.Range("fini")), Month(O.Range("fini")), Day(O.Range("fini"))) 'définit la date de fin DF
AD = Year(DD): AF = Year(DF) 'définit l'année de début AD
NL = AF - AD + 1 'définit l'année de fin AF
'***************************
'définition du tableau final
'***************************
ReDim TF(1 To NL + 1, 1 To 16) 'redimensione le tableau final TF (NL + 1 lignes, 16 colonnes)
For I = 1 To 16 'boucle de 1 à 16
'définit la donnée ligne 1 colonne I de TF
TF(1, I) = Choose(I, "", "Jan", "Fev", "Mar", "Abr", "Mai", "Jun", "Jul", "Ago", "Set", "Out", "Nov", "Dez", "soma", "Prop", "Média")
Next I 'prochaine colonne de la boucle
For I = 0 To NL - 1 'boucle de 0 à NL-1
TF(I + 2, 1) = AD + I 'définit l'année de la ligne I+2 de la colonne 1
Next I 'prochaine ligne de la boucle
For I = 2 To UBound(TV, 1) 'boucle 1 : sur toutes les lignes I du tableau des valeur TV (en partant de la seconde)
On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
D = DateSerial(Year(TV(I, 2)), Month(TV(I, 2)), Day(TV(I, 2))) 'définit la date D (génère une erreur si TV(I,2) est vide)
If Err <> 0 Then 'condition : si une erreur a été générée
Err.Clear 'supprime l'erreur
GoTo fin 'va à l'étiquette fin
End If 'fin de la condition
On Error GoTo 0 'annule la gestion des erreurs
COL = Month(D) + 1 'définit la colonne COL
For J = 2 To UBound(TF, 1) 'boucle 2 : sur toutes les années de TF
If Year(D) = TF(J, 1) Then 'condition : si l'année de la date D est égale à l'année de la boucle 2
LI = J 'définit la ligne LI
TF(LI, COL) = TV(I, 5) 'renvoie dans la donnée ligne LI colonne COL de TF la valeur de la donnée ligne I colonne 5 de TV
Exit For 'for de la boucle 2
End If 'fin de la condition
Next J 'prochaine année de la boucle 2
Next I 'prochaine ligne de la boucle 1
fin: 'étiquette
'soma, prop e Média
For I = 2 To UBound(TF, 1) 'boucle 1 : sur toutes les années de TF
N = 0: T = 0 'initialise le nombre N et la Total T
For J = 2 To 13 'boucle 2 sur tous les mois de TF
If TF(I, J) <> "" Then 'condition : si le donnée ligne I colonne J de TF n'est pas vide
N = N + 1 'incrémente N
T = T + TF(I, J) 'additionne les données de l'année
End If 'fin de la condition
Next J 'prochaine mois de la boucle 2
TF(I, 14) = T 'renvoie dans la donnée ligne I colonne 14 de TF le total T
TF(I, 15) = N 'renvoie dans la donnée ligne I colonne 15 de TF le nombre N
TF(I, 16) = Round(TF(I, 14) / TF(I, 15), 2) 'calcule dans la donnée ligne I colonne 16 de TF la moyenne
Next I 'prochaine ligne de la boucle 1
O.Range("B66").Resize(UBound(TF, 1), UBound(TF, 2)).Value = TF 'renboie en B66 redimensionnée de l'onglet O le tableau TF
'*****************
'Fomat et couleurs
'*****************
Set PL = O.Range("B66").CurrentRegion 'définit la plage PL
'bordures
With PL
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
End With
With PL.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With PL.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With PL.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With PL.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With PL.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With PL.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
End With
'alignement ligne 1
PL.Rows(1).HorizontalAlignment = xlCenter
'gras colonne 1
PL.Columns(1).Font.Bold = True
'gras Soma, Prop e Média
O.Range(PL.Cells(1, 14), PL.Cells(1, 16)).Font.Bold = True
'couleur étiquettes mois
With O.Range(PL.Cells(1, 2), PL.Cells(1, 13)).Interior
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
End With
'couleur cellules colonne O à Q
With Application.Intersect(PL, O.Columns("O:Q")).Interior
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
End With
'format nombre avec 2 virgules des colonne C à Q
With Application.Intersect(PL, O.Columns("C:Q"))
.NumberFormat = "0.00"
End With
'couleur rouge des données des mois
With O.Range(O.Cells(67, 3), O.Cells(PL.Rows.Count + 66, 14)).Font
.Color = -16777024
.TintAndShade = 0
End With
End Sub
