Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, x$
With ListObjects(1).DataBodyRange 'tableau Excel
Set r = Intersect(Target, Union(.Columns(2), .Columns(4)))
If r Is Nothing Then Exit Sub
Set r = Intersect(r.EntireRow, .Columns(2))
End With
Application.ScreenUpdating = False
For Each r In r 'si entrées multiples (copier-coller)
r(1, 5).Font.Name = "Consolas" 'RAZ, police à chasse fixe pour un bon alignement
r(1, 5).Font.Size = r.Font.Size - 0.5 'RAZ
r(1, 5).Font.ColorIndex = xlAutomatic 'RAZ
If IsNumeric(r) And r <> 0 And IsNumeric(CStr(r(1, 3))) Then
x = Format(r(1, 3) / r - 1, "0%")
If Left(x, 1) = "-" Then 'valeur < 0
r(1, 5) = "ê" & String(6 - Len(x), " ") & x
r(1, 5).Characters(1, 1).Font.ColorIndex = 3 'rouge
Else 'valeur >= 0
r(1, 5) = "é" & String(6 - Len(x), " ") & x
r(1, 5).Characters(1, 1).Font.ColorIndex = 10 'vert
End If
r(1, 5).Characters(1, 1).Font.Name = "Wingdings"
r(1, 5).Characters(1, 1).Font.Size = r.Font.Size + 1
Else
r(1, 5) = ""
End If
Next
End Sub