Sub Remplacer()
'chaîne aXb-cXd avec a b c d nombres entiers < 1000 et X une lettre unique
Dim tablo, ncol%, i&, j%, t, pmoins%, k%, lettre$, x$, p1%, p2%
With ActiveSheet.UsedRange
tablo = .Formula 'matrice, plus rapide
If Not IsArray(tablo) Then tablo = .Resize(2).Formula 'au moins 2 éléments
ncol = UBound(tablo, 2)
For i = 1 To UBound(tablo)
For j = 1 To ncol
t = tablo(i, j)
pmoins = InStr(t, "-") 'position du signe -
If pmoins Then
p1 = 0: p2 = 0
For k = 1 To Len(t)
lettre = Mid(t, k, 1)
If UCase(lettre) Like "[A-Z]" Then
If p1 = 0 Then
'---coef a---
x = Left(t, k - 1)
If Not IsNumeric(x) Then Exit For
If CDbl(x) <> Int(x) Or Val(x) > 999 Then Exit For
'---coef b---
x = Mid(t, k + 1, pmoins - k - 1)
If Not IsNumeric(x) Then Exit For
If CDbl(x) <> Int(x) Or Val(x) > 999 Then Exit For
p1 = k 'mémorise
Else
If lettre <> Mid(t, p1, 1) Then Exit For 'il faut la même lettre, casse respectée
'---coef c---
x = Mid(t, pmoins + 1, k - pmoins - 1)
If Not IsNumeric(x) Then Exit For
If CDbl(x) <> Int(x) Or Val(x) > 999 Then Exit For
'---coef d---
x = Mid(t, k + 1)
If Not IsNumeric(x) Then Exit For
If CDbl(x) <> Int(x) Or Val(x) > 999 Then Exit For
p2 = k 'mémorise
Exit For 'ajouté pour réduire la durée d'exécution
End If
End If
Next k
If p2 Then tablo(i, j) = Left(t, p2 - 1) 'modification du tableaau
End If
Next j, i
'---restitution---
.Formula = tablo
End With
End Sub