Sub nettoyage()
Dim oCel As Range, s As String, i As Long, tf As Boolean
For Each oCel In Selection
tf = False
s = ""
For i = 1 To Len(CStr(oCel))
Select Case Mid$(CStr(oCel), i, 1)
Case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"
s = s & Mid$(CStr(oCel), i, 1)
Case ".", ","
If tf Then Exit For
tf = True
If Len(Mid$(CStr(oCel), i)) > 4 Then
If Not (Mid$(CStr(oCel), i + 4, 1) Like [",."] Or Len(Mid$(CStr(oCel), i + 1, 3)) = 3) Then Exit For
ElseIf Len(Mid$(CStr(oCel), i)) <> 4 Then
Exit For
End If
End Select
Next i
If s <> "" Then oCel.Value = s
Next oCel
End Sub