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

 

[job75]

La macro précédente efface les mots clés s'il y a au moins 1 ou 2 mots devant.

Cette macro les efface toujours, même s'il y a moins de mots :

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) '2 espaces devant pour avoir au moins 3 "mots"
        s = Split(x)
        ub = UBound(s)
        y = LCase(s(ub))
        If y = "test" Or y = "essai" Then tablo(i, 1) = Trim(Left(x, Len(x) - Len(s(ub - 1) & y) - 1))
        If y = "simul" Or y = "result" Then tablo(i, 1) = Trim(Left(x, Len(x) - Len(s(ub - 2) & s(ub - 1) & y) - 2))
    Next
    '---restitution---
    If .Parent.FilterMode Then .Parent.ShowAllData 'si la feuille est filtrée
    .Value = tablo
End With
End Sub

Pour tester j'ai recopié la plage C2:C25 sur 48 000 lignes.

La macro de sousou s'exécute en 1,4 seconde (en ajoutant Application.ScreenUpdating = False).

La macro de ce post s'exécute en 0,12 seconde.

 

[jmfmarques]

Bonjour à chacun
Que ferait ceci (petit exemple de traitement d'une chaîne) :

Private Sub CommandButton1_Click()
  MsgBox extrait_selon("aaaa bbb ccc simul")
  MsgBox extrait_selon("ccc dddd bbb aaaa simul")
  MsgBox extrait_selon("ccc dddd")
  MsgBox extrait_selon("ccc dddd test")
  MsgBox extrait_selon("ccc dddd xxxx xxxxx xxxxy result")
End Sub

Private Function extrait_selon(ch As String) As String
  If ch Like "* test" Or ch Like "* essai" Then nb = 2
  If ch Like "* simul" Or ch Like "* result" Then nb = 3
  extrait_selon = ch
  For k = 1 To nb
    pos = InStrRev(extrait_selon, " ") - 1
    If pos > 1 Then extrait_selon = Left(extrait_selon, pos) Else Exit For
  Next
End Function

 

[job75]

Pour tester la méthode de JM post #11 j'ai lancé cette macro :

Sub mSuppression()
Dim temps, t As Variant, p&, c As Range
temps = Timer
Application.ScreenUpdating = False
For Each c In Range("C2:C48001")
  t = Split("  " & c) '2 espaces pour avoir au moins 3 mots
    Select Case t(UBound(t))
    Case Is = "test", "essai"
    ReDim Preserve t(0 To (UBound(t) - 2))
    c = Trim(Join(t, " "))
    Case Is = "simul", "result"
    ReDim Preserve t(0 To (UBound(t) - 3))
    c = Trim(Join(t, " "))
    End Select
  Erase t
Next c
MsgBox Timer - temps
End Sub

Elle s'exécute chez moi en 0,35 seconde.

Salut jmfmarques.