Séparé le contenu d'une cellule a partir d'un terme spécifique

JNP à dit:

Bonjour le fil ,
A la demande de JM, je passe par là, sachant que RegExp n'est pas forcément la panacé dans ce cas de figure. En effet, il serait bien plus puissant si un réel motif pouvait être décelé (que des consonnes dans le sigle ou uniquement les sigles en majuscules par exemple) ce qui n'est pas le cas ici .
J'avoue que la solution de Tibo me plait bien, les seuls défauts que j'ai trouvés, c'est la perte de l'espace pour une raison sociale au milieu, et... que je n'ai pas trouvé comment agrandir la liste des exclusions dans sa formule .
Maintenant, si on veux s'amuser avec RegExp, le Pattern de JM n'est pas tout à fait bon, puisqu'il va transformer la société : SARL SARA PORTEPASMAL en PORTEPASMAL, par exemple, ce qui est dommage pour le jeu de mot ...
Ça signifie donc qu'il va falloir travailler sur une liste exhaustive, à l'unité.
Pour récupérer la liste, j'ai été chercher le fichier de l'INSEE proposé par JM, et là, avec tout l'avantage de RegExp, j'ai extrait toutes les abréviations en me basant sur le fait que ce n'était que des ensembles de majuscules.

Code:

[COLOR=blue]Function[/COLOR] ExtractionSigles(Plage [COLOR=blue]As[/COLOR] Range) [COLOR=blue]As String[/COLOR]
Application.Volatile
[COLOR=blue]Dim[/COLOR] Match, Matches, Cellule [COLOR=blue]As[/COLOR] Range
[COLOR=blue]With[/COLOR] CreateObject("vbscript.regexp")
[COLOR=blue]For Each[/COLOR] Cellule [COLOR=blue]In[/COLOR] Plage
    .Global = [COLOR=blue]True[/COLOR]: .Pattern = "[A-Z]{2,}"
    [COLOR=blue]Set[/COLOR] Matches = .Execute(Cellule)
    [COLOR=blue]For Each[/COLOR] Match [COLOR=blue]In[/COLOR] Matches
    ExtractionSigles = ExtractionSigles & " " & Match
[COLOR=blue]Next[/COLOR]
[COLOR=blue]End With[/COLOR]
[COLOR=blue]End Function[/COLOR]

Il m'a suffit d'utiliser le séparateur blanc pour décomposer en cellules, copier/coller transposé et supprimer les doublons.
J'ai ensuite ajouté les civilités traditionnelles (j'ai laissé tombé Son Altesse Sérénissime, vu qu'elle existait déja dans les sociétés ).
J'ai ensuite fait une petite fonction pour fabriquer mon Pattern

Code:

[COLOR=blue]Function[/COLOR] FabricationPattern(Plage [COLOR=blue]As[/COLOR] Range) [COLOR=blue]As String[/COLOR]
Application.Volatile
[COLOR=blue]Dim[/COLOR] Cellule [COLOR=blue]As[/COLOR] Range
[COLOR=blue]For Each[/COLOR] Cellule [COLOR=blue]In[/COLOR] Plage
FabricationPattern = FabricationPattern & "|" & Cellule
[COLOR=blue]Next[/COLOR]
FabricationPattern = " ?\b(" & Right(FabricationPattern, Len(FabricationPattern) - 1) & ")\b ?(?!\.)"
[COLOR=blue]End Function[/COLOR]

Là, quelque explications pour Winnie s'imposent :
" ?" : 0 ou 1 espace
"\b" : fin de mot devant
"(CUMA|GAEC|...)" : CUMA ou GAEC ou ...
"\b ?" : idem
"(?!\.)" : mais n'ayant pas un "." après (pour ne pas ôter le M de R.M.T.I. par exemple.
Maintenant, il ne reste plus qu'une petite fonction pour traiter tout cela :

Code:

[COLOR=blue]Function[/COLOR] SansTitre(Cellule [COLOR=blue]As[/COLOR] Range, MonPattern [COLOR=blue]As String[/COLOR], [COLOR=blue]Optional[/COLOR] Remplacement [COLOR=blue]As String[/COLOR], [COLOR=blue]Optional[/COLOR] Inverse [COLOR=blue]As Boolean[/COLOR]) [COLOR=blue]As String[/COLOR]
Application.Volatile
[COLOR=blue]Dim[/COLOR] Match, Matches
[COLOR=blue]If[/COLOR] Cellule.Count > 1 [COLOR=blue]Then Exit Function[/COLOR]
[COLOR=blue]If[/COLOR] Inverse = [COLOR=blue]False Then[/COLOR]
[COLOR=blue]With[/COLOR] CreateObject("vbscript.regexp")
    .Global = [COLOR=blue]True[/COLOR]: .Pattern = MonPattern
    SansTitre = Trim(.Replace(Cellule, Remplacement))
[COLOR=blue]End With[/COLOR]
[COLOR=blue]Else[/COLOR]
    [COLOR=blue]With[/COLOR] CreateObject("vbscript.regexp")
        .Global = [COLOR=blue]True[/COLOR]: .Pattern = Replace(MonPattern, " ?", "")
        [COLOR=blue]Set[/COLOR] Matches = .Execute(Cellule)
        [COLOR=blue]For Each[/COLOR] Match [COLOR=blue]In[/COLOR] Matches
            SansTitre = SansTitre & " " & Match
        [COLOR=blue]Next[/COLOR]
    [COLOR=blue]End With[/COLOR]
    SansTitre = Trim(SansTitre)
[COLOR=blue]End If[/COLOR]
[COLOR=blue]End Function[/COLOR]

et lui donner les arguments suivants :

Code:

=SansTitre(Cellule_à_traiter;Pattern_à_utiliser;En_option_remplacer_par;En_option_l_inverse)

Je vous mets le comparatif en PJ.
Bonne journée

Cliquez pour agrandir...

winnie à dit:

Je sais que je peux faire une formule de ce style

Code:

STXT(A1;1;4)

et pareil pour le libellé.

Mais le problème et que je dois ensuite importer ce fichier dans un autre logiciel et que lorsque cellule comporte une formule, le logiciel ne reconnait pas la colonne.

Cliquez pour agrandir...

=GAUCHE(A1;5)

=SansTitre(A1;"\d{4}[A-Z]";;VRAI)

=DROITE(A1;NBCAR(A1)-8)

=SansTitre(A1;"(\d{4}[A-Z]| - )")

Staple1600 à dit:

Rassures toi, JNP_Obi , moi je préfère tes jolis patterns
J'ose espérer en découvrir plein d'autres de ta griffe ,au hasard des fils à venir sur XLD.

Cliquez pour agrandir...

winnie à dit:

Mais en regardant de plus près, j'ai bien compris son fonctionnement.
Et pour te rassurer je m'en sert, ton travail n'a pas était vain.

Cliquez pour agrandir...