Option Base 1
'Rectification des arrondis sur la plage "_Moy" pour ramener le total des pourcentages à 100
'Rectifications faites dans l'ordre des priorités indiqué dans le tableau Idx
Function Arrondi_Rectifié() As Variant
Application.Volatile True
Dim Idx, C As Range, Col As Long, i, j As Byte, Somme As Byte
Dim TbV, NbV As Byte, TbA(), TbDp(), DbDg()
Dim P1 As Double, G1 As Double, Pi As Byte, Gi As Byte
Idx = Array(1, 4, 3, 5, 2) 'à adapter pour le nb de col et l'ordre de priorité des rectifications à respecter
Set C = Application.Caller: Col = C.Column - C.Parent.[_Moy].Column + 1: TbV = C.Parent.[_Moy]
Somme = Round(C.Parent.[_Moy].Offset(0, -1).Resize(1, 1), 0)
NbV = UBound(TbV, 2)
ReDim TbA(1 To NbV): ReDim TbDp(1 To NbV):: ReDim tbDg(1 To NbV)
j = 0
Set C = Nothing
For Each i In Idx
j = j + 1
TbA(j) = Round(TbV(1, i), 0): Somme = Somme + TbA(j)
'Parties décimales inférieures à 0.5 pour rectification par augmentation
TbDp(j) = IIf(Round(TbV(1, i) - Int(TbV(1, i)), 2) < 0.5, Round(TbV(1, i) - Int(TbV(1, i)), 2), 0)
'Parties décimales supérieures ou égales à 0.5 pour rectification par diminution
tbDg(j) = IIf(Round(TbV(1, i) - Int(TbV(1, i)), 2) >= 0.5, Round(TbV(1, i) - Int(TbV(1, i)), 2), 1)
Next
Erase TbV
With WorksheetFunction
P1 = .Large(TbDp, 1) '1ère plus grande décimale <.5
Pi = .Match(P1, TbDp, 0) 'N° de la colonne
TbDp(Pi) = 0 'On ignore la valeur retenue ci-dessus
P1 = .Large(TbDp, 1) '2ème plus grande décimale <.5
Pj = .Match(P1, TbDp, 0) 'N° de la colonne
G1 = .Small(tbDg, 1) '1ère plus petite décimale >= 0.5
Gi = .Match(G1, tbDg, 0) 'N° de la colonne
tbDg(Gi) = 1 'On ignore la valeur retenue ci-dessus
G1 = .Small(tbDg, 1) '2ème plus petite décimale >= 0.5
gj = .Match(G1, tbDg, 0) 'N° de la colonne
Col = .Match(Col, Idx, 0) 'N° de la colonne à prendre en compte dans l'ordre des priorité
End With
Select Case Somme 'Rectification en fonction de la somme des arrondis
Case 98
TbA(Pi) = TbA(Pi) + 1
TbA(Pj) = TbA(Pj) + 1
Case 99
TbA(Pi) = TbA(Pi) + 1
Case 101
TbA(Gi) = TbA(Gi) - 1
Case 102
TbA(Gi) = TbA(Gi) - 1
TbA(gj) = TbA(gj) - 1
Case Else
'pas de rectification
End Select
Arrondi_Rectifié = TbA(Col) 'Renvoie de la colonne concérnée
End Function