Sub Mise_en_Forme()
Set mondico = CreateObject("Scripting.Dictionary")
For Each c In Range("B5", [B65000].End(xlUp))
If Len(c) = 5 Then
mondico.Item(Left(c.Value, 2)) = mondico.Item(Left(c.Value, 2)) + 1
End If
Next c
For Each c In Range("b5", [B65000].End(xlUp))
c.Font.ColorIndex = 1
c.Offset(0, 3).Font.ColorIndex = 1
If Len(c) = 5 Then
If mondico.Item(Left(c.Value, 2)) > 1 Then
Select Case Left(c.Value, 2)
'Ici préfixe du code postal concerné
Case 14 'Calvados
c.Font.ColorIndex = 27
c.Offset(0, 3).Font.ColorIndex = 27
Case 29 'Finistère
c.Font.ColorIndex = 5
c.Offset(0, 3).Font.ColorIndex = 5
Case 35
c.Font.ColorIndex = 3 'rouge
c.Offset(0, 3).Font.ColorIndex = 3
Case 37
c.Font.ColorIndex = 7
c.Offset(0, 3).Font.ColorIndex = 7
Case 44
c.Font.ColorIndex = 8
c.Offset(0, 3).Font.ColorIndex = 8
Case 49
c.Font.ColorIndex = 42 'vert
c.Offset(0, 3).Font.ColorIndex = 42
Case 56
c.Font.ColorIndex = 10
c.Offset(0, 3).Font.ColorIndex = 10
Case 72
c.Font.ColorIndex = 11
c.Offset(0, 3).Font.ColorIndex = 11
Case 85
c.Font.ColorIndex = 12
c.Offset(0, 3).Font.ColorIndex = 12
Case 86
c.Font.ColorIndex = 13
c.Offset(0, 3).Font.ColorIndex = 13
End Select
End If
End If
Next c
End Sub