Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Microsoft 365 Suppression des deux ou trois derniers mots dans cellules

Moreno076

XLDnaute Impliqué
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
 
Solution
Pour tester la méthode de JM post #11 j'ai lancé cette macro :
VB:
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.

job75

XLDnaute Barbatruc
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 :
VB:
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

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

VB:
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

XLDnaute Barbatruc
Pour tester la méthode de JM post #11 j'ai lancé cette macro :
VB:
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.
 

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…