supprimer multiiples lignes par macro

pasquetp

XLDnaute Occasionnel
bonjour a tous,

je tente une macro pour supprimer des lignes par macro et etrangement la macro ne fait pas tous le travail demande

en page 1: vous avez une liste

en page 2 une autre liste

on supprime en page 2 les lignes SI la donnees en colonne A DE LA PAGE 2 n'est pas trouve en colonne A de la page 1. ( attention si les donnees de la colonne A de la page 1 ne sont pas trouvees en page 2, j'ai deja une macro qui marche pour cela)



je vous donne ci joint un exemple: en page 1 : 14 donnees et en page 2 : 21 donnees

merci encore a tous
 

Pièces jointes

  • PROBLEME.xlsm
    31.3 KB · Affichages: 41

Iznogood1

XLDnaute Impliqué
Bonjour,

un code du genre :
Code:
Option Explicit

Sub SuppLigne()
  Dim r As Range
  Dim f As Range
  Dim i As Integer
  Dim lignesASupprimer As New Collection
 
  'On cherche toutes les valeurs dans SORT absentes de DATA et on enregistre leurs n° de ligne
  For Each r In Worksheets("Sort").Range("A2:A" & Worksheets("Sort").Range("A1").CurrentRegion.Rows.Count)
  Set f = Worksheets("data").Range("A:A").Find(r.Value)
  If f Is Nothing Then lignesASupprimer.Add r.Row
  Next r
 
  'On supprime les lignes 1 à 1 en partant de la fin pour ne pas se casser la tête avec les décalages dus aux suppressions
  For i = lignesASupprimer.Count To 1 Step -1
  Worksheets("Sort").Range("A" & lignesASupprimer(i)).EntireRow.Delete
  Next
 
End Sub
 

Iznogood1

XLDnaute Impliqué
Code:
fin2 = Sheets("sort").Range("A65536").End(xlUp).Row
  a = 0
  For deux = 2 To fin2
  Set pagee1 = Sheets("data").Columns(1).Find(Sheets("sort").Cells(deux, 1), LookIn:=xlValues, LookAt:=xlWhole)
  If Not pagee1 Is Nothing Then
  Else
  a = a + 1
  Sheets("sort").Cells(deux, 1).EntireRow.Delete
  End If
  Next

Dans ton fichier, la valeur de la ligne 16 n'existe pas, donc tu supprimes la ligne 16.
Jusque là, tout va bien.
Mais du coup, la ligne 17 et devenue ligne 16, la ligne 18 est devenue ligne 17 etc...

Ensuite, tu vérifie la ligne 17, donc tu oublie l'ancienne ligne 17 qui est devenue 16 !

Il faudrait que ton code soit le suivant :
Code:
  fin2 = Sheets("sort").Range("A65536").End(xlUp).Row
  a = 0
  For deux = 2 To fin2
  Set pagee1 = Sheets("data").Columns(1).Find(Sheets("sort").Cells(deux, 1), LookIn:=xlValues, LookAt:=xlWhole)
  If Not pagee1 Is Nothing Then
  Else
  a = a + 1
  Sheets("sort").Cells(deux, 1).EntireRow.Delete
'******** AJOUTE CES 2 LIGNES *****
  deux = deux - 1
  fin2 = fin2 - 1 'pas obligé, mais plus propre
'*************************************
  End If
  Next
 

Discussions similaires

Réponses
6
Affichages
447

Statistiques des forums

Discussions
311 725
Messages
2 081 945
Membres
101 849
dernier inscrit
florentMIG