XL 2010 suppression de ligne si la valeur ne correspond pas au texte contenu dans un tableau VBA

[ricorico]

Bonjour,

Je suis à la recherche d'une fonction VBA me permettant de supprimer les lignes qui ne contiennent pas le texte que j'ai ajouté dans un tableau VBA.

Je dispose d'un Excel qui se génère toutes les semaines avec dans la colonne A des catégories qui peuvent changer de place (il peut avoir des catégories qui s'ajoutent ou se suppriment en fonction des semaines) et dans les colonnes suivantes des valeurs numériques.

J'aimerai créer une macro qui me permet de garder seulement les lignes qui m'intéresse, peu importe leur emplacement dans la colonne A. J'ai créer un tableau avec la fonction Array qui contient les catégories que je souhaite garder.

Y'a t'il une fonction qui permet de comparer la cellule A2 avec toutes les valeurs de mon tableau, si la catégories correspond, alors on passe à la cellule A3, sinon on supprime la ligne et ainsi de suite.

Je ne sais pas si je suis très clair, si vous avez des questions n'hésitez pas

 

[vgendron]

Bonjour
Avec un fichier exemple, ce serait quand meme mieux

 

[ricorico]

Voici un exemple, j'aimerais par exemple qu'après que la macro aies tourné, il me reste que la ligne BC, FG, JK et LM car ces 4 catégories sont dans mon tableau Array

 

[vgendron]

ci joint:
la liste des lignes à garder dans la feuille 1
suppression des lignes
tri pour rassembler les lignes en haut du tableau

 

[Efgé]

Bonjour

Une autre, toujours avec la liste des lignes a garder en Feuil1:

Sub Autre()
Dim D As Object
Dim i&

Set D = CreateObject("Scripting.dictionary")

With Sheets("Feuil1")
    For i = 2 To .Cells(.Rows.Count, 1).End(3).Row
        D(.Cells(i, 1)) = ""
    Next i
End With

With Sheets("UPTIME PAR TOOL SET")
    For i = .Cells(.Rows.Count, 1).End(3).Row To 2 Step -1
        If Not D.Exists(.Cells(i, 1)) Then .Rows(i).Delete
    Next i
End With
End Sub

Cordialement

 

[ricorico]

Parfait, ça fonctionne merci !!

 

[Efgé]

Bonjour à toutes et tous, le fil, le forum
De retour de congés je laisse une version plus "propre" et surtout plus rapide sur un grand nombre de lignes.
Lancement du code par alt+F8

Sub Autre_2()
Dim D As Object, Rng As Range
Dim i&, j&, Rw&
Dim Treport As Variant

Set D = CreateObject("Scripting.dictionary")
With Sheets("UPTIME PAR TOOL SET")
    Set Rng = .Range(.Cells(2, 1), .Cells(.Cells(Rows.Count, 1).End(3).Row, .Cells(1, Columns.Count).End(1).Column))
End With
Treport = Rng
 
With Sheets("Feuil1")
    For i = 2 To .Cells(.Rows.Count, 1).End(3).Row
        D(Trim(UCase(.Cells(i, 1)))) = ""
    Next i
End With

For i = LBound(Treport, 1) To UBound(Treport, 1)
    If D.exists(Trim(UCase(Treport(i, 1)))) Then
        Rw = Rw + 1
        For j = LBound(Treport, 2) To UBound(Treport, 2)
            Treport(Rw, j) = Treport(i, j)
        Next j
    End If
Next i

Application.ScreenUpdating = False
    Rng.Offset(Rw).Delete
    If Rw Then Rng.Resize(Rw, UBound(Treport, 2)) = Treport
Application.ScreenUpdating = True

End Sub

Cordialement