Microsoft 365 formules pour remplacer les caractères "st" et "ste" en début de chaine de texte ou dans la chaine si séparés par 1 espace avant et 1 espace après

[Usine à gaz]

Re-Bonjour à toutes et à tous,

Me voilà devant un nouveau souci

Pour mon fichier communes de France, environ 40000 communes, j'ai besoin de remplacer les caractères "st" et "ste" en début de chaine de texte ou dans la chaine si séparés par 1 espace avant et 1 espace après.
Pour le début de chaine, pas de souci.

Mais voilà avec ma formule actuelle en colonne "E" du fichier test joint, tous les st ou ste, où qu'ils soient positionnés dans la chaine sont remplacés par "saint" ou "sainte".
Evidemment, cela me change les noms des communes et ça ne fait pas mon affaire lol ou plutôt pas lol du tout

A l'instant, malgré mes recherches et tentatives, je n'ai pas trouvé la solution.
Auriez-vous la bonne formule ?
Fichier test joint,

Je continue mes recherches.
A grand merci par avance,
Amicalement,
lionel,

 

[laurent950]

Cette fois-ci il prend bien les sainte et saint.
Mais voilà le souci qui apparait :
st aubin ste vaast (62140)
donne en résultat : sainte aubin sainte vaast (62140)
alors qu'il faudrait : saint aubin sainte vaast (62140)

Je suis vraiment désolé du temps que tu passes à mon besoin

Re @Usine à gaz

J'ai repris

Option Explicit
Sub test()
Dim Rgn As Range
     Set Rgn = Range(Cells(6, 3), Cells(Cells(65536, 3).End(xlUp).Row, 3))
Dim cel As Range
Dim NewCommune As String
Dim Str As String

Dim Match As Object
Dim Matches As Object
Dim StrPattern As String
Dim reg As Object
        Set reg = CreateObject("VBScript.RegExp")
    StrPattern = "(^\s(ste)\s)|(^(ste)\s)|(\s(ste)\s)|(\s(ste)\s$)|(^\s(st)\s)|(^(st)\s)|(\s(st)\s)|(\s(st)\s$)"
    reg.Pattern = StrPattern
    reg.MultiLine = True: reg.IgnoreCase = False: reg.Global = True
    For Each cel In Rgn
    NewCommune = cel.Value
        Set Matches = reg.Execute(cel.Value)
            If reg.Execute(cel.Value).Count >= 1 Then
                For Each Match In Matches
                    If Trim(Match.Value) = "ste" Then
                        Str = " sainte "
                        NewCommune = Replace(NewCommune, Match.Value, Str)
                    ElseIf Trim(Match.Value) = "st" Then
                        Str = " saint "
                        NewCommune = Replace(NewCommune, Match.Value, Str)
                    End If
                        Str = Empty
                Next Match
                cel.Offset(, 2).Value = Trim(NewCommune)
            Else
                cel.Offset(, 2).Value = Trim(cel.Value)
            End If
            NewCommune = Empty
    Next cel
 
' libération d'objets
    Set Matches = Nothing
    Set Match = Nothing
    Set reg = Nothing
    Set Rgn = Nothing
    Set cel = Nothing
    Str = Empty
    NewCommune = Empty
End Sub

 

[Usine à gaz]

Merci beaucoup Laurent
Mais là, je n'en peux plus.
Je prendrai un moment pour tester demain
Douce nuit

 

[laurent950]

@Usine à gaz

Il y a encore des réglage je verrais demain soir c'est pas encore ca

Bonne nuit à demain

 

[Usine à gaz]

lol, j'ai déjà vu
Je préparerai mieux les résultats attendus demain

 

[laurent950]

ol, j'ai déjà vu
Je préparerai mieux les résultats attendus demain

Bonjour @Usine à gaz

Le Nouveau code ci-dessous remis à jour

Option Explicit
Sub test()
Dim Rgn As Range
     Set Rgn = Range(Cells(6, 3), Cells(Cells(65536, 3).End(xlUp).Row, 3))
Dim cel As Range

Dim Match As Object
Dim Matches As Object
Dim i As Byte
Dim StrPattern() As String
    ReDim StrPattern(0 To 1, 0 To 2)
    StrPattern(0, 0) = "(^\s(ste)\s)|(^(ste)\s)|(\s(ste)\s)|(\s(ste)\s$)"
    StrPattern(0, 1) = " sainte "
    StrPattern(1, 0) = "(^\s(st)\s)|(^(st)\s)|(\s(st)\s)|(\s(st)\s$)"
    StrPattern(1, 1) = " saint "
Dim reg As Object
        Set reg = CreateObject("VBScript.RegExp")
    For i = LBound(StrPattern, 1) To UBound(StrPattern, 1)
        reg.Pattern = StrPattern(i, 0)
        reg.MultiLine = True: reg.IgnoreCase = False: reg.Global = True
        For Each cel In Rgn
            Set Matches = reg.Execute(cel.Value)
                If reg.Execute(cel.Value).Count >= 1 Then
                    If reg.Execute(cel.Value).Count >= 1 Then
                        For Each Match In Matches
                            If cel.Offset(, 2).Value = Empty Then
                                cel.Offset(, 2).Value = Trim(reg.Replace(cel.Value, StrPattern(i, 1)))
                            Else
                                cel.Offset(, 2).Value = Trim(reg.Replace(cel.Offset(, 2).Value, StrPattern(i, 1)))
                            End If
                        Next Match
                    End If
                Else
                    cel.Offset(, 2).Value = Trim(cel.Value)
                End If
        Next cel
    Next i
 
' libération d'objets
    Set Matches = Nothing
    Set Match = Nothing
    Set reg = Nothing
    Set Rgn = Nothing
    Set cel = Nothing
End Sub

 

[Usine à gaz]

Bonjour à toutes et à tous,
Je vous souhaite une belle journée

@laurent : Désolé, je n'étais pas dispo hier;
Merci pour ce nouveau code
Je regarde ce soir et je te réponds.
lionel,