Macro pour supprimer lignes si... Le sujet est résolu

Y compris Power BI, Power Query et toute autre question en lien avec Excel
m
myexcel
Membre habitué
Membre habitué
Messages : 59
Inscrit le : 1 décembre 2019

Message par myexcel » 3 janvier 2020, 17:50

Bonjour

Dans mon fichier PJ je veux 1 macro qui permet de supprimer les lignes de la feuille "titulaire" quand la date de fin et date de recrutement est inférieur à une année (360 jours) (colonne M - Colonne L)

Merci
titulaire.xlsx
(10.28 Kio) Téléchargé 2 fois
Avatar du membre
bigdaddy154
Membre impliqué
Membre impliqué
Messages : 1'207
Appréciations reçues : 47
Inscrit le : 5 mars 2014
Version d'Excel : 2010

Message par bigdaddy154 » 3 janvier 2020, 18:01

Bonsoir,

à mettre dans un nouveau module vba.
Sub suppression()
    Dim drligne As Single, i As Single
    Dim tps As Single
    
    drligne = Range("L" & Rows.Count).End(xlUp).Row
    
    For i = drligne To 2 Step -1
        tps = Range("M" & i).Value2 - Range("L" & i).Value2
        If tps >= 360 Then
            Rows(i).Delete
        End If
    Next i
End Sub
Cordialement.
1 membre du forum aime ce message.
m
myexcel
Membre habitué
Membre habitué
Messages : 59
Inscrit le : 1 décembre 2019

Message par myexcel » 3 janvier 2020, 18:33

Merci beaucoup....ça marche très bien :bien:
juste une chose que j'ai oublié de préciser je veux mettre le bouton de la macro dans une autre feuille (feuille Module). (voir PJ)
titulaire2.xlsm
(16.23 Kio) Téléchargé 1 fois
m
m3ellem1
Membre impliqué
Membre impliqué
Messages : 1'509
Appréciations reçues : 124
Inscrit le : 18 décembre 2018
Version d'Excel : 2016

Message par m3ellem1 » 3 janvier 2020, 18:46

Salut tout le monde,

voici une autre macro
Sub SupprimLignes()
Dim DerLign As Long
Dim i As Integer
With Sheets("Titulaire")
DerLign = [M65536].End(xlUp).Row

For i = DerLign To 2 Step -1
    If DateDiff("d", .Cells(i, 12), .Cells(i, 13)) < 360 Then .Rows(i & ":" & i).EntireRow.Delete
Next i
End With
End Sub
1 membre du forum aime ce message.
m
myexcel
Membre habitué
Membre habitué
Messages : 59
Inscrit le : 1 décembre 2019

Message par myexcel » 3 janvier 2020, 18:56

m3ellem1 ça marche très bien...mais je veux mettre le bouton de la macro dans une autre feuille et non dans la même feuille du tableau.

si vous pouvez ajouter un msbox indiquant nbr de lignes supprimées....Merci d'avance
m
m3ellem1
Membre impliqué
Membre impliqué
Messages : 1'509
Appréciations reçues : 124
Inscrit le : 18 décembre 2018
Version d'Excel : 2016

Message par m3ellem1 » 3 janvier 2020, 19:56

Re,

essaie comme ca, le boutton tu peux le mettre où tu veux ca n'a aucune importance!
Sub SupprimLignes()
Dim DerLign As Long
Dim i As Integer, a As Integer
With Sheets("Titulaire")
DerLign = .[M65536].End(xlUp).Row

For i = DerLign To 2 Step -1
    If DateDiff("d", .Cells(i, 12), .Cells(i, 13)) < 360 Then
    .Rows(i & ":" & i).EntireRow.Delete
    a = a + 1
    End If
Next i
End With
MsgBox "Le nombre de lignes supprimées est : " & a, vbInformation, "nombre de lignes supprimées"
End Sub
Modifié en dernier par m3ellem1 le 4 janvier 2020, 15:06, modifié 1 fois.
m
myexcel
Membre habitué
Membre habitué
Messages : 59
Inscrit le : 1 décembre 2019

Message par myexcel » 3 janvier 2020, 20:16

:( le bouton ne marche pas dans d'autres feuilles
m
m3ellem1
Membre impliqué
Membre impliqué
Messages : 1'509
Appréciations reçues : 124
Inscrit le : 18 décembre 2018
Version d'Excel : 2016

Message par m3ellem1 » 3 janvier 2020, 20:56

à tester
titulaire2_1.xlsm
(17.8 Kio) Téléchargé 3 fois
Sinon mets le fichier avec le boutton qui fonctionne pas et puis on verra ...
m
myexcel
Membre habitué
Membre habitué
Messages : 59
Inscrit le : 1 décembre 2019

Message par myexcel » 4 janvier 2020, 13:07

Bonjour

Bizarre ton fichier fonctionne parfaitement bien ...alors que le mien avec le même code ne fonctionne pas.
je te le met en PJ pour voir ce qui ne marche pas....Merci
titulaire2.xlsm
(17.77 Kio) Téléchargé 4 fois
m
m3ellem1
Membre impliqué
Membre impliqué
Messages : 1'509
Appréciations reçues : 124
Inscrit le : 18 décembre 2018
Version d'Excel : 2016

Message par m3ellem1 » 4 janvier 2020, 15:06

Re,

oui il y a un point (pour référence qui manque) :lol:
je viens de le corriger dans le code en haut
DerLign = .[M65536].End(xlUp).Row
1 membre du forum aime ce message.
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message