Excel macro pour supprimer les lignes contenant des mots clés

Fermé
kitten13 - Modifié par kitten13 le 29/05/2014 à 11:26
ccm81 Messages postés 10815 Date d'inscription lundi 18 octobre 2010 Statut Membre Dernière intervention 18 février 2024 - 5 déc. 2014 à 16:35
Bonjour,

A l'aide de MACRO j'aimerais supprimer les lignes dont la première cellule (colonne A) contient l'un des mots clés prédéfinie dans une liste (Renault, fiat, BMW, etc.).

J'ai donc procéder comme ceci (mais ça ne fonctionne pas):

Merci de votre aide !

Option Explicit
Option Base 1
Sub DeleteIfKeywords()
 Dim r As Long, lr As Long, n As Long, k, i As Long
 Application.ScreenUpdating = False
 k = Array("Fiat", "Renault")
 lr = Cells(Rows.Count, 1).End(xlUp).Row
 For r = lr To 2 Step -1
   n = 0
   For i = LBound(k) To UBound(k)
  If InStr(Cells(r, 1), k(i)) = 0 Then
    n = n + 1
    Exit For
  End If
   Next i
   If n = 0 Then Rows(r).Delete
 Next r
 Application.ScreenUpdating = True
End Sub
A voir également:

3 réponses

ccm81 Messages postés 10815 Date d'inscription lundi 18 octobre 2010 Statut Membre Dernière intervention 18 février 2024 2 403
Modifié par ccm81 le 29/05/2014 à 12:08
Bonjour

Essaies comme ceci

Sub DeleteIfKeywords()
Dim r As Long, lr As Long, k, i As Long
Application.ScreenUpdating = False
k = Array("Fiat", "Renault")
lr = Cells(Rows.Count, 1).End(xlUp).Row
For r = lr To 2 Step -1
For i = LBound(k) To UBound(k)
If InStr(UCase(Cells(r, 1)), UCase(k(i))) > 0 Then
Rows(r).Delete
Exit For
End If
Next i
Next r
Application.ScreenUpdating = True
End Sub

Cdlmnt
1
f894009 Messages postés 17177 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 19 février 2024 1 701
29 mai 2014 à 12:01
Bonjour a vous deux,

une autre methode:

Option Explicit
Option Base 1
Sub DeleteIfKeywords()
Dim Lr As Long, k, i As Long, Nb, Plage As Range, lig, point
Application.ScreenUpdating = False

With Worksheets("feuil1")
k = Array("Fiat", "Renault")
For i = LBound(k) To UBound(k)
Lr = .Cells(Rows.Count, 1).End(xlUp).Row
'mise en memoire plage de cellules
Set Plage = .Range("A2:A" & Lr)
'nombre d'iteration
Nb = Application.CountIf(Plage, k(i))
If Nb > 0 Then
lig = 1
For point = 1 To Nb
'recherche ligne et positionnement pour tour suivant
lig = .Columns(1).Find(k(i), .Cells(lig, 1), , xlWhole).Row
Rows(lig).Delete
Next point
End If
Next i
End With
Application.ScreenUpdating = True
End Sub
0
Cette fonction ne marche pas du tout !
0
michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 304
5 déc. 2014 à 13:45
Excelmacro voulait écrire:
Merci pour le temps passé par 3 bénévoles mais cela ne semble pas fonctionner dans mpn cas que je n'ai pas eu la patience d'expliquer
0
ccm81 Messages postés 10815 Date d'inscription lundi 18 octobre 2010 Statut Membre Dernière intervention 18 février 2024 2 403
5 déc. 2014 à 16:35
@michel

Bravo pour l'interprétation, c'est fou tout ce qu'on peut dire en si peu de mots non ? ;-)

ccm81
0
michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 304
29 mai 2014 à 12:04
Bonjour,

Combien as tu de lignes environ?
il y a des solutions différentes suivant le nombre: soit par "Find" ou par dictionary et variable-tableau
0
michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 304
29 mai 2014 à 12:23
Bonjour,

Si peu de lignes ( <1000),
les mots clés ne sont pas forcément isolés par ex: Fiat 500

Sub detruire_si()
Dim T_car, Idx As Integer, Nbre As Integer
Dim Cptr As Integer, Lig As Integer

Application.ScreenUpdating = False
T_car = Array("Fiat", "Renault", "BMW", "Audi", "Peugeot", "Rover")

For Idx = 1 To UBound(T_car)
Nbre = Application.CountIf(Columns("A"), "*" & T_car(Idx) & "*")
If Nbre > 0 Then
For Cptr = 1 To Nbre
Lig = Columns("A").Find(T_car(Idx), Range("A1"), xlValues).Row
Rows(Lig).Delete
Next
End If
Next
End Sub
0