Supprimer des lignes en fonction d'éléménts d'une colonne

Le 26/06/2018 à 16:33

Bonjour

J'ai pas mal cherché mais je n'ai rien trouvé qui soit à ma portée.

J'ai une liste (colonne) avec des noms, ceux que je veux garder.

J'ai d'autres colonnes dont la première (A) correspond à plein d'autres noms.

Je cherche à écrire le code qui supprimera les lignes des noms qui ne font pas partie de ma liste.

J'ai ce code qui fonctionne bien:

Sub efface_les_autres_noms()

Dim cell As Range

Dim test As Integer

Dim i As Integer

dl = Range("AD65536").End(xlUp).Row

For i = dl To 2 Step -1

If (Cells(i, 1).Value = "NOM1àenlever") Or (Cells(i, 1).Value = "NOM2àenlever") Or (Cells(i, 1).Value = "NOM3àenlever") Then test = 1

If test = 1 Then Rows(i).Delete

test = 0

End Sub

mais j'aurais aimé pouvoir gérer la liste de noms à enlever autrement (il y en a maintenant 50) et je suis sur qu'il y a plus optimisé

Par avance merci

Cdt

Charles

Le 26/06/2018 à 16:50

Bonjour Charles, bonjour le forum,

J'ai une liste (colonne) avec des noms, ceux que je veux garder.

Avec ce genre d'indication, difficile de t'aider... Je te propose un petit fichier exemple si tu souhaites obtenir de l'aide plus rapidement.

Le 26/06/2018 à 17:24

En pj un fichier d'exemple

La seconde feuille pour remettre les infos initiales après l’exécution de la macro.

J'ai une piste en passant par la fonction trouve mais je n'arrive pas à la transposer en vba avec ma boucle.

Merci

12test.xlsm (28.31 Ko)

Le 27/06/2018 à 10:58

Bonjour Charles, bonjour le forum,

En pièce jointe ton fichier modifié avec le code ci-dessous :

Sub Macro1()
Dim D As Worksheet 'déclare la variable D (onglet Data)
Dim D2 As Worksheet 'déclare la variable D2 (onglet Data (2))
Dim TV As Variant 'déclare la variable TV (Tableau ds Valeurs)
Dim TNG As Variant 'déclare la variable TNG (Tableau des Noms à Garder)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim K As Integer 'déclare la variable K (incrément)
Dim L As Integer 'déclare la variable L (incrément)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)

Set D = Worksheets("DATA") 'définit l'onglet D
Set D2 = Worksheets("Data (2)") 'définit l'onglet D2
D2.Cells.ClearContents 'efface d'éventuelles anciennes valeurs dans l'onglet D2
TV = D.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
TNG = D.Range("G1").CurrentRegion 'définit le tableau des nom à garder TNG
K = 1 'initalise la variable K
For J = 2 To UBound(TNG, 1) 'boucle 1 : sur toutes les lignes J du tableau des noms à garder TNG (en partant de la seconde)
    For I = 2 To UBound(TV, 1) 'boucle 2 : sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
        If TV(I, 1) = TNG(J, 1) Then 'condition : si les deux valeurs sont égales
            ReDim Preserve TL(1 To UBound(TV, 2), 1 To K) 'redimensionne le tableau des lignes TL (autant de lignes que TV a de colonne, K colonnes)
            For L = 1 To UBound(TV, 2) 'boucle 3 : sur toutes les colonne L du tableau des valeur TV
                TL(L, K) = TV(I, L) 'récupère dans la ligne L de TL, la valeur en colonne L de TV (=> transposition)
            Next L 'prochaine colonne de la boucle
            K = K + 1 'incrément K (ajoute une colonne au tableau des lignes TL)
        End If 'fin de la condition
    Next I 'prochaine ligne de la boucle 2
Next J 'prochaine ligne de la boucle 1
If K > 1 Then 'condition : si K est supérieur à 1
    D2.Range("A1").Resize(1, UBound(TV, 2)).Value = Application.Index(TV, 1) 'renvoie les étiquettes du tableau TV dans la première ligne de l'onglet D2
    D2.Range("A2").Resize(UBound(TL, 2), UBound(TL, 1)).Value = Application.Transpose(TL) 'renvoie dans A2 redimensionnée de l'onglet D2, le tableau TL transposé
End If
End Sub

10charles-v01.xlsm (30.10 Ko)

Le 27/06/2018 à 13:01

Bonjour

Juste parfait

Merci beaucoup

Je le garde précieusement pour l'adapter au besoin

Le 13/07/2018 à 12:06