[RESOLU] VBA supprimer ligne si valeur trouvée sur une autre feuille

mdidish

XLDnaute Junior
Bonjour à tous.

Je cherche à automatiser la fonction suivante :
- j'ai des données en Feuil1, dont un code numérique en colonne A ;
- j'ai une série de valeurs numériques en colonne A de Feuil2 (il peut y avoir des cellules vides, par exemple une valeur en A1 et A2, rien en A3, une valeur en A4, etc.) ;
- je veux supprimer de la Feuil1 toutes les lignes dont le code en colonne A est présent dans la colonne 1 de Feuil2

Est-ce possible ?
Merci d'avance.
 
Dernière édition:

M.S.

XLDnaute Nouveau
Hello mdidish,
Merci beaucoup pour ton aide, la macro fonctionne parfaitement comme suit, maintenant j'aimerais l'appliquer à tous les mois de l'année. Rajouter les feuilles : Janvier, Février ..........Décembre.

Private Sub Workbook_Open()

Dim i, j, k As Integer
Dim Base, Janv As String
Base = "Base éléves"
Janv = "Janvier"
For i = Sheets(Base).Range("A65536").End(xlUp).Row To 2 Step -1
For j = Sheets(Base).Range("L65536").End(xlUp).Row To 2 Step -1
For k = Sheets(Janv).Range("B65536").End(xlUp).Row To 3 Step -1
If (Sheets(Base).Range("A" & i) = Sheets(Janv).Range("B" & k) And IsDate(Sheets(Base).Range("L" & j).Value) And CDate(Sheets(Base).Range("L" & j)) < CDate(Date)) Then
Sheets(Janv).Range("B" & k).EntireRow.Delete shift:=xlUp
End If
Next
Next
Next
End Sub
 

BrunoM45

XLDnaute Barbatruc
Bonjour M.S.

Merci de formater correctement vos post SVP

Le code doit être mis entre balise afin d'améliorer la lisibilité, et ceci grâce au bouton
1637808026931.png

Voilà ce que ça donne

VB:
Private Sub Workbook_Open()

Dim i, j, k As Integer
Dim Base, Janv As String
Base = "Base éléves"
Janv = "Janvier"
For i = Sheets(Base).Range("A65536").End(xlUp).Row To 2 Step -1
For j = Sheets(Base).Range("L65536").End(xlUp).Row To 2 Step -1
For k = Sheets(Janv).Range("B65536").End(xlUp).Row To 3 Step -1
If (Sheets(Base).Range("A" & i) = Sheets(Janv).Range("B" & k) And IsDate(Sheets(Base).Range("L" & j).Value) And CDate(Sheets(Base).Range("L" & j)) < CDate(Date)) Then
Sheets(Janv).Range("B" & k).EntireRow.Delete shift:=xlUp
End If
Next
Next
Next
End Sub

A+
 
Dernière édition:

mdidish

XLDnaute Junior
Tu peux ajouter une boucle sur le mois.
Je ne sais pas combien de lignes tu auras par feuille, possible que ça devienne un peu long avec les 4 boucles intriquées.

VB:
Private Sub Workbook_Open()
Dim i, j, k, l As Integer
Dim Base As String
Dim fMois(1 To 12) As String

fMois(1) = "Janvier"
fMois(2) = "Fevrier"
fMois(3) = "Mars"
fMois(4) = "Avril"
fMois(5) = "Mai"
fMois(6) = "Juin"
fMois(7) = "Juillet"
fMois(8) = "Aout"
fMois(9) = "Septembre"
fMois(10) = "Octobre"
fMois(11) = "Novembre"
fMois(12) = "Decembre"

Base = "Base éléves"

For l = 1 To 12
For i = Sheets(Base).Range("A65536").End(xlUp).Row To 2 Step -1
For j = Sheets(Base).Range("L65536").End(xlUp).Row To 2 Step -1
For k = Sheets(fMois(l)).Range("B65536").End(xlUp).Row To 3 Step -1
If (Sheets(Base).Range("A" & i) = Sheets(fMois(l)).Range("B" & k) And IsDate(Sheets(Base).Range("L" & j).Value) And CDate(Sheets(Base).Range("L" & j)) < CDate(Date)) Then
Sheets(fMois(l)).Range("B" & k).EntireRow.Delete shift:=xlUp
End If
Next
Next
Next
End Sub

Je ne suis pas sûr de ce que tu veux faire, mais ce qui va se passer :

VB:
For i = Sheets(Base).Range("A65536").End(xlUp).Row To 2 Step -1
tu vas boucler sur chaque élève

Code:
For j = Sheets(Base).Range("L65536").End(xlUp).Row To 2 Step -1
pour chaque élève, tu vas boucler sur la date de sortie de l'ensemble des élèves ? Si tu veux juste prendre la date de sortie de l'élève sélectionné, tu remplaces
VB:
IsDate(Sheets(Base).Range("L" & j)
par
VB:
IsDate(Sheets(Base).Range("L" & i)

Code:
For k = Sheets(Janv).Range("B65536").End(xlUp).Row To 3 Step -1
Pour chaque couple élève / date de sortie, tu vas boucler sur les lignes de l'onglet du mois

et tout ça pour chaque feuille mensuelle de manière successive.
Vérifie :
- que le contenu de fMois() correspond aux noms que tu vas vraiment donner à tes feuilles (majuscule, accent, etc)
- supprime les occurences dont tu n'as pas besoin si tu n'as pas 12 mois ; par exemple, si tu n'as que 10 mois, tu supprimes fMois(11) et fMois(12)

Si l'exécution est trop longue, tu peux déjà inactiver la mise à jour de l'écran pendant l'exécution du script, en ajoutant dans ton script
Au début (après Private Sub Workbook_Open()):
Code:
Application.ScreenUpdating = True

A la fin (avant End Sub) :
Code:
Application.ScreenUpdating = False
 

M.S.

XLDnaute Nouveau
Hello mdidish,
Merci beaucoup pour ton aide. J'ai pu finaliser le code pour mon classeur selon tes indications. Avec cependant quelques corrections, mais c'était exactement ce dont j'avais besoin :

VB:
For k = Sheets(fMois(1)).Range("B65536").End(xlUp).Row To 3 Step -1
Devient:
Code:
For j = Sheets(fMois(k)).Range("B65536").End(xlUp).Row To 3 Step -1

Voici le résultat :

Code:
Private Sub Workbook_Open()

Application.ScreenUpdating = True

    Dim i, j, k As Integer
    Dim Base, fMois(1 To 12) As String
    
Base = "Base éléves"
fMois(1) = "Janvier"
fMois(2) = "Février"
fMois(3) = "Mars"
fMois(4) = "Avril"
fMois(5) = "Mai"
fMois(6) = "Juin"
fMois(7) = "Juillet"
fMois(8) = "Aout"
fMois(9) = "Septembre"
fMois(10) = "Octobre"
fMois(11) = "Novembre"
fMois(12) = "Décembre"

For k = 1 To 12
   For i = Sheets(Base).Range("A65536").End(xlUp).Row To 2 Step -1
        For j = Sheets(fMois(k)).Range("B65536").End(xlUp).Row To 3 Step -1
            If (Sheets(Base).Range("A" & i) = Sheets(fMois(k)).Range("B" & j) And IsDate(Sheets(Base).Range("L" & i).Value) And CDate(Sheets(Base).Range("L" & i)) < CDate(Date)) Then
             Sheets(fMois(k)).Range("B" & j).EntireRow.Delete shift:=xlUp
            End If
         Next
    Next
Next
    Application.ScreenUpdating = False
End Sub
 

Discussions similaires