XL 2019 "Saucissonner" une phrase suivant des critères

[gerardphi]

Bonjour,
J'aurais besoin de votre aide!

J'ai des phrases composées de différents termes géologique (temps géologique et les différentes roches).
Je souhaiterai copier des mots ou un ensemble de mots et les coller dans une autre cellule suivant des critères
Les critères sont toujours précédé d'un espace.
Les critères sont (en rouge sur la PJ): le point, 2 points, la virgule, entre parenthèse ouvrante et fermée, le tiret, "et", "à"
Je réserve les cellules B1:E1 pour créer un critère à la demande. C'est à dire, si je veux sortir ce qui est après "/", je tape "/" dans la cellule B1 et je retrouve les résultat dans la colonne B.

Au final, je souhaitera avoir une BDD où je peux refaire le lien entre : une roche pendant ce temps géologique.

Je suis à votre disposition pour tous renseignements complémentaire, merci de votre aide!
Je suis ouvert à toutes suggestions!
Cordialement

 

[sylvanu]

Bonsoir Gerardphi,

Je suis parti en utilisant comme séparateur : ":", "-","à", "et", "("
Mais j'ai quelques soucis lors du saucissonnage :
Le "et" est un séparateur dans : "Molasse sableuse et gréseuse ("Helvétien")"
mais pas dans "sables, galets et blocs (stade 5)"
Le "-" est un séparateur pour le premier mais pas pour le second dans "Saône-Rhône - Miocène indifférencié"
La "(" est un séparateur dans " inférieurs (Kimméridgien supérieur)" mais pas dans "galets et blocs (stade 5)"

Question : comment lever ces ambiguïtés ?

Si on peut lever toutes ces ambiguïtés, cela pourrait ressembler à cette PJ. Avec :

Sub Découpe()
    Dim L%, i%, C%, Chaine$
    Application.ScreenUpdating = False
        Range("F2:O" & Range("A65500").End(xlUp).Row).ClearContents
    For L = 2 To Range("A65500").End(xlUp).Row
        Chaine = Cells(L, "A")
        R = Array(": ", "-", " à ", " et ", "(")
        For i = 0 To UBound(R)
            Chaine = Replace(Chaine, R(i), "£")
        Next i
        Chaine = Replace(Chaine, ")", "")
        tablo = Split(Chaine, "£")
        For C = 0 To UBound(tablo)
            Cells(L, 6 + C) = tablo(C)
        Next C
    Next L
    Application.ScreenUpdating = True
End Sub

Question : Combien avez vous de lignes dans votre fichier ?
S'il y en a beaucoup, il faut opter pour une structure plus rapide.

 

[gerardphi]

Bonjour Sylvanu,
Super travail
J'ai résolu le problème de "Saône-Rhône - Miocène, en insérant un espace après "- " dans la macro
La solution ne serait-elle pas de faire un saucissonnage suivant un ordre de "priorité", exemple:
1_ parenthèse
2_ tiret
3_ 2 points
3_ "à" (garder le à)
4_"et" (garder le et)
Merci de votre aide!
Cela fonctionne très bien avec 700 ligne!!!

 

[sylvanu]

Bonjour Gerardphi,
Une priorisation ne changera pas grand chose aux ambiguïtés, auxquelles vous n'avez pas répondu.
Pourquoi conserver "(stade 5)" entier, mais séparer "("Helvétien")" .
Pourquoi conserver le "et" dans "sables, galets et blocs" mais pas dans "sableuse et gréseuse".
En PJ j'ai rajouté les espaces, et je suis passé par un array, ce qui accélère grandement le traitement.

 

[sousou]

Bonjour à tous
Même problème pour le et??
Sub decoupe()
With ActiveCell
rangt = 1: deb = 1: fin = 1
nbc = Len(.Value)
For n = 1 To nbc
c = Mid(.Value, n, 2)
If cherche(c) = True Then
'If deb = 1 Or Mid(.Value, n - 1, 1) = " " Then

fin = n
mot = Mid(.Value, deb, fin - deb)
deb = fin

MsgBox mot
'End If
End If
Next
mot = Mid(.Value, deb, Len(.Value) - deb + 1)
MsgBox mot


End With
End Sub

Function cherche(c)
t = Array(" :", " ,", " -", " à", "et", " (", ", ", " ;")
For x = 0 To UBound(t)

If c = t(x) Then cherche = True: Exit For
Next
End Function

 

[gerardphi]

Sylvanu,

• "argiles, sables, galets et blocs (stade 5)" concerne l'érosion des roches, et Helvétien concerne le temps géologique, c'est différent
• Pourquoi conserver le "et" dans "sables, galets et blocs" mais pas dans "sableuse et gréseuse". Cela n'est pas cohérent car les 2 concernent des roches. "Sableuse et gréseuse" devrait être dans la même colonne
• J'avais relevé aussi d'autres ambiguïtés .....

Aux regards des ambiguïtés générés par les éléments de ce fichier, j'ai baissé mes ambitions. Sauf à faire une "usine à gaz" en allant chercher les infos dans une BDD pour lever quelques ambiguïtés .... à la marge!

Je considère que vous avez répondu à mes attentes !!!

Sylvanu et Sousou,
je vous remercie, c'est super sympa!!!!!

Bonne soirée
Cordialement