Discussion :

[bougyfab]

Bonjour à tous.

Tout d'abord, désolé si le sujet a déjà été abordé, mais je n'ai rien trouvé sur ce sujet spécifique!

je vous expose mon problème / ma demande :-)


Je souhaite automatiser la suppression de lignes dans un fichier excel.
Afin d'illustrer ma problématique, un fichier excel en pièce jointe, et une formule pour montrer un peu le besoin

En gros: j'ai une base de donnée avec des numéros de véhicule (Feuille de calcul = "Table")
J'aimerais pouvoir supprimer les lignes dont les cellules véhicule ne sont pas dans la liste de la base de donnée (Feuille de calcul ="export OA(450)")

Avec une formule SI + RECHERCHEV + EST erreur, j'arrive à avoir le retour suivant:
véhicule dans la liste = OK
véhicule absent de la liste = à supprimer.

L'étape suivante, sur laquelle j'avoue ne pas trop savoir comment m'y prendre serait de passer par un bouton sur la feuille "accueil" qui permette de faire ces suppression, sans passer par une formule!

Je vois bien une boucle qui teste si la valeur de la cellule est comprise dans la liste
une variable de test

mais.....

J'espère m'être fait comprendre! et surtout avoir une réponse à mon problème ;-)

D'avance merci à tous

[EricDgn]

Bonjour,

Une macro qui permet de faire cela:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Option Explicit
 
Sub Supprim_Ligne_Veh()
   Dim rTable As Range
   Dim LastRow As Long, kRow As Long
   Dim rOK As Range
   If Left(ActiveSheet.Name, 6) <> "export" Then
      If MsgBox("Traiter cette feuille: " & ActiveSheet.Name, vbYesNo, "Oui?") = vbNo Then
         Exit Sub
      End If
   End If
   Set rTable = ActiveWorkbook.Worksheets("Table").Range("A:A")
   LastRow = Cells(Rows.Count, 2).End(xlUp).Row    '--- n° de la dernière ligne en colonne 2
   For kRow = LastRow To 2 Step -1          '--- commencer par la fin (évite pbl avec suppression ligne)
      Set rOK = rTable.Find(what:=Cells(kRow, 2).Value, LookAt:=xlWhole)
      If rOK Is Nothing Then
         Rows(kRow).Delete Shift:=xlUp   '--- pas trouvé, supprime ligne
      Else
         Cells(kRow, 4) = "Ok"
      End If
   Next kRow
   Set rOK = Nothing
   Set rTable = Nothing
End Sub

Bonne continuation.

[bougyfab]

Bonjour EricDGN

Tout d'abord, merci pour ta réponse.

Ensuite, je suis en train d'adapter le code que tu m'a fourni. Ma faute car je n'ai fourni qu'un "bout" du fichier que je vais traiter!

L'idée est d'avoir un bouton sur la feuille "Accueil" ==> ça c'est fait, j'ai attribuer la macro au bouton en question (rien de trop dur jusqu'ici)

par contre, la routine qui vérifie si la feuille est bien celle sélectionné me provoquait une erreur

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
If Left(ActiveSheet.Name, 15) <> "export OA (450)" Then
      If MsgBox("Traiter cette feuille: " & ActiveSheet.Name, vbYesNo, "Oui?") = vbNo Then
         Exit Sub
      End If
    End If

J'ai donc modifié le code ainsi, mais il faut que je creuse encore car toute mes lignes disparaissent :-)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Option Explicit
 
Sub Supprim_Ligne_Veh()
   Dim rTable As Range
   Dim LastRow As Long, kRow As Long
   Dim rOK As Range
   If Left(ActiveSheet.Name, 15) <> "export OA (450)" Then
    Worksheets("export OA (450)").Activate
 
      'If MsgBox("Traiter cette feuille: " & ActiveSheet.Name, vbYesNo, "Oui?") = vbNo Then
      '   Exit Sub
      'End If
    End If
   'Worksheets("export OA (450)").Activate
   Set rTable = ActiveWorkbook.Worksheets("Table").Range("A:A")
   LastRow = Cells(Rows.Count, 2).End(xlUp).Row    '--- n° de la dernière ligne en colonne 2
   For kRow = LastRow To 2 Step -1          '--- commencer par la fin (évite pbl avec suppression ligne)
      Set rOK = rTable.Find(what:=Cells(kRow, 2).Value, LookAt:=xlWhole)
      If rOK Is Nothing Then
         Rows(kRow).Delete Shift:=xlUp   '--- pas trouvé, supprime ligne
      Else
         Cells(kRow, 4) = "Ok"
      End If
   Next kRow
   Set rOK = Nothing
   Set rTable = Nothing
End Sub

[bougyfab]

PFFFF.
c'était juste la variable rTable qui était mal défini.
dans mon exemple, et dans le code proposé: Range ("A:A")
Dans mon "vrai" fichier Range ("Q:Q")

J'aurais aussi pu passer par le nom d'entête de la colonne! mais ça fonctionne très bien comme ça, donc merci!