Sub test()
For n = 2 To Range("B65536").End(xlUp).Row
For m = 1 To Len(Range("B" & n))
If Mid(Range("B" & n), m, 1) = 5 Then
For p = 1 To 4
If IsNumeric(Mid(Range("B" & n), m + p, 1)) Then
t = t + 1
End If
Next p
If t = 4 Then
t = 0
Range("C" & n) = Mid(Range("B" & n), m, 5)
Exit For
End If
End If
Next m
Next n
End Sub
Sub macro()
Dim c As Range
Dim RegEx As Object
Set RegEx = CreateObject("vbscript.regexp")
Set doublon = CreateObject("scripting.dictionary")
With RegEx
For Each c In Range("B1", Range("B" & Rows.Count).End(xlUp))
.Pattern = "(5)[0-9]{5}"
.Global = True
tmp = ""
If .test(c.Value) Then
tmp = CDbl(.Execute(c.Value)(0))
cle = "Cle_" & tmp
If doublon.exists(cle) = False Then
doublon(cle) = 1
Else
doublon(cle) = doublon(cle) + 1
End If
Cells(c.Row, 3).Value = CDbl(.Execute(c.Value)(0))
End If
Next c
End With
Set RegEx = Nothing
'-------------------------------------------------
' ecriture du nombre d'appel
'-------------------------------------------------
l = 1
col = 4
For Each cle In doublon
Cells(l, col) = Mid(cle, 5)
Cells(l, col + 1) = doublon(cle)
l = l + 1
Next
End Sub