Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Columns("b:b"), Target) Is Nothing Then CompterColorier
End Sub
Sub CompterColorier()
Dim rouge, rose, orange, vert
Dim derlig, t, i&, ref0, ref, n
Application.ScreenUpdating = False
rouge = RGB(255, 0, 0): rose = RGB(255, 100, 255): orange = RGB(50, 100, 250): vert = RGB(0, 200, 100)
derlig = Application.Match(9E+99, Columns("b:b"), 1)
t = Range("b1:b" & derlig + 1)
ref0 = ""
For i = UBound(t) - 1 To 2 Step -1
If t(i, 1) < -1 / 100 Then ref = rouge Else If t(i, 1) < 0 Then ref = rose Else If t(i, 1) < 1 / 100 Then ref = orange Else ref = vert
If ref = ref0 Then
n = n + 1
Cells(i, "c") = n: Cells(i, "c").Font.Bold = True
Cells(i, "c").Font.Color = ref
Else
If t(i, 1) < -1 / 100 Then ref0 = rouge Else If t(i, 1) < 0 Then ref0 = rose Else If t(i, 1) < 1 / 100 Then ref0 = orange Else ref0 = vert
n = 1
Cells(i, "c") = n: Cells(i, "c").Font.Bold = True
Cells(i, "c").Font.Color = ref0
End If
Next i
End Sub