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 10854 Date d'inscription lundi 18 octobre 2010 Statut Membre Dernière intervention 26 avril 2024 - 5 déc. 2014 à 16:35
ccm81 Messages postés 10854 Date d'inscription lundi 18 octobre 2010 Statut Membre Dernière intervention 26 avril 2024 - 5 déc. 2014 à 16:35
A voir également:
- Excel macro pour supprimer les lignes contenant des mots clés
- Supprimer une page word - Guide
- Supprimer compte instagram - Guide
- Liste déroulante excel - Guide
- Aller à la ligne excel - Guide
- Supprimer les doublons excel - Guide
3 réponses
ccm81
Messages postés
10854
Date d'inscription
lundi 18 octobre 2010
Statut
Membre
Dernière intervention
26 avril 2024
2 404
Modifié par ccm81 le 29/05/2014 à 12:08
Modifié par ccm81 le 29/05/2014 à 12:08
Bonjour
Essaies comme ceci
Cdlmnt
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
f894009
Messages postés
17185
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
15 avril 2024
1 702
29 mai 2014 à 12:01
29 mai 2014 à 12:01
Bonjour a vous deux,
une autre methode:
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
michel_m
Messages postés
16603
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
16 décembre 2023
3 303
5 déc. 2014 à 13:45
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
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
ccm81
Messages postés
10854
Date d'inscription
lundi 18 octobre 2010
Statut
Membre
Dernière intervention
26 avril 2024
2 404
5 déc. 2014 à 16:35
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
Bravo pour l'interprétation, c'est fou tout ce qu'on peut dire en si peu de mots non ? ;-)
ccm81
michel_m
Messages postés
16603
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
16 décembre 2023
3 303
29 mai 2014 à 12:04
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
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
michel_m
Messages postés
16603
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
16 décembre 2023
3 303
29 mai 2014 à 12:23
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
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