Microsoft 365 Suppression des deux ou trois derniers mots dans cellules

[Moreno076]

Bonjour à tous,

Je souhaiterais en macro que si dans une colonne commençant par la cellune C2 :

- si le dernier mot de la cellule est "test" ou "essai" alors supprimer les deux derniers mots ;
- si le dernier mot de la cellule est "simul" ou "result" alors supprimer les trois derniers mots.

sinon laisser la cellule comme tel.

Merci pour votre aide

 

[sousou]

Bonjour
Comme nous le disons souvent Un fichier joint avec des exemples précis c'est plus facile et plus attirant pour vous proposer des solutions

 

[Moreno076]

Bonjour Sousou.

CI joint le fichier.

J'ai mis en fluo les cellules donnant d exemple.
Au final il ne devrait rester d'ecrit que PRODUIT B et PRODUIT C

Merci

 

[sousou]

re
Dans le module sousou j'ai créé ta procédure, pour le moment le résuktat est affiché dans un msgbox pour validation, Je te laisse vérifier, et coupler cela dan ton ensemble

 

[Moreno076]

Re.

J essai de comprendre mais en vain. Le message box donne les désignations correctes.
J'ai enlevé du coup la ligne msg box cel mais rien ne se passe

 

[sousou]

Bien sur, je n'ai pas remplacé la valeur
corrige comme ceci
Sub decoupe()
With Sheets("synthèse")
drlg = .Cells(.Cells(.UsedRange.Columns(3).Rows.Count + 1, 3).End(xlUp).Row, 3).Row
Set Z = .Range(.Cells(16, 3), .Cells(drlg, 3))
'Z.Select
For Each Cel In Z
Set result = Cel
n = InStrRev(Cel, " ")
dmot = Right(Cel, Len(Cel) - n)
r = sitest(dmot)
For nbmot = 1 To r
n = InStrRev(Cel, " ")
Cel = Left(Cel, n - 1)
Next
result.Value = Cel
Next
End With
End Sub

 

[Moreno076]

Impeccable ca fonctionne à merveille.

Merci beaucoup

 

[Moreno076]

Impeccable ca fonctionne à merveille.

Merci beaucoup

Re

je ne comprends plus ca fonctionnait et quand j'ai fait d autres test ca ne fonctionne plus
J'ai remplacé des mots.

 

[sousou]

re
Pour éviter les problèmes de casse, j'ai mis lcase(v) (qui met tout en minuscule)dans la procédure, tu dois donc écrire 'dose' en minuscule.
si tu souhaites tenir compte de la casse alors supprime le lcase(v)
exemple: if v="DOSE".... ect

 

[Moreno076]

j y avais pensé pour min/maj j avais changé le texte mais ca ne fonctionnait pas il me semble.
La tout fonctionne avec v merci. bonne nuit.

 

[Staple1600]

Bonsoir le fil

Juste pour le fun (et pour varier les plaisirs)
A n'utiliser qu'en guise de lecture avant d'aller se coucher
(Car en vrai, il y aura surement des effets de bord)
1) Lancer la macro Pour_Test (sur une feuille vierge)
2) Puis lancer la macro mSuppression

Sub Pour_Test()
With Application
[C2:C5] = .Transpose([{"abc def toto tutu test","jojo titi tutu jaja essai","abc toto tutu simul","tata tutu toto result"}])
End With
End Sub
Sub mSuppression()
Dim t As Variant, p&, c As Range
For Each c In Range("C2:C5")
  t = Split(c)
    Select Case t(UBound(t))
    Case Is = "test", "essai"
    For p = 0 To UBound(t) - 1
    t(p) = t(p)
    Next
    ReDim Preserve t(0 To (UBound(t) - 2))
    c = Join(t, " ")
    Case Is = "simul", "result"
    For p = 0 To UBound(t) - 1
    t(p) = t(p)
    Next
    ReDim Preserve t(0 To (UBound(t) - 3))
    c = Join(t, " ")
    End Select
  Erase t
Next c
End Sub

Normalement, on obtient ce qui est décrit en message#1

 

[Moreno076]

J'ai testé vite fait je n'ai pas regardé le detail mais ca donne ca

 

[Staple1600]

Re

J'avais écris: tester sur une feuille vierge
(et non pas sur ton appli)
C'est juste un code "illustratif"
Qui peut-être intéressera un lecteur curieux

 

[job75]

Bonjour Moreno076, sousou, JM,

Une solution assez simple, toujours avec Split :

Sub Epurer()
Dim tablo, i&, x$, s, ub%, y$
With Sheets("Synthèse").UsedRange.Columns(3)
    tablo = .Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
    For i = 2 To UBound(tablo)
        x = tablo(i, 1)
        s = Split(x)
        ub = UBound(s)
        If ub > -1 Then
            y = LCase(s(ub))
            If (y = "test" Or y = "essai") And ub > 0 Then tablo(i, 1) = Trim(Left(x, Len(x) - Len(s(ub - 1) & y) - 1))
            If (y = "simul" Or y = "result") And ub > 1 Then tablo(i, 1) = Trim(Left(x, Len(x) - Len(s(ub - 2) & s(ub - 1) & y) - 2))
        End If
    Next
    '---restitution---
    If .Parent.FilterMode Then .Parent.ShowAllData 'si la feuille est filtrée
    .Value = tablo
End With
End Sub

A+

 

[Moreno076]

Merci