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 10850 Date d'inscription lundi 18 octobre 2010 Statut Membre Dernière intervention 27 mars 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:

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

Réponse 1 / 3

ccm81 Messages postés 10850 Date d'inscription lundi 18 octobre 2010 Statut Membre Dernière intervention 27 mars 2024 2 404
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

Réponse 2 / 3

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 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

Excelmacro
5 déc. 2014 à 12:18

Cette fonction ne marche pas du tout !

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

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

ccm81 Messages postés 10850 Date d'inscription lundi 18 octobre 2010 Statut Membre Dernière intervention 27 mars 2024 2 404
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

Réponse 3 / 3

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

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

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

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

Discussions similaires

programme qui n'affiche pas le mot secret

Afficher toutes les lignes masquées excel

Discussions similaires

Newsletters