macro qui supprime les lignes suivant conditions

thierry440

XLDnaute Junior
Bonjour

je cherche à faire une macro qui balaye et supprime les lignes ayant le conditions suivantes :
-statut : cloturé
et
-année : inférieur 2016

Merci d'avance
 

Fichiers joints

Calvus

XLDnaute Barbatruc
Bonsoir,

Ton fichier en retour.

Code :
VB:
Sub Efface()
Dim i As Integer
For i = 2 To Range("B" & Rows.Count).End(xlUp).Row
    If Cells(i, 3) = "cloturé" And CDate(Cells(i, 9)) < CDate(2016) Then
        Cells(i, 3).EntireRow.Delete
    End If
Next i
End Sub
A+
 

Fichiers joints

Staple1600

XLDnaute Barbatruc
Bonsoir le fil, le forum

Sans boucle (n'est-ce pas Calvus ;))
VB:
Sub a()
Dim pf As Range
With [B1].CurrentRegion
    .Item(2, 10).FormulaR1C1 = "=(RC[-8]=""cloturé"")+(YEAR((""1/1/""&RC[-2])*1)<2016)=2"
    .AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("K1:K2"), Unique:=False
End With
Set pf = [_FilterDataBase]
Application.DisplayAlerts = False
If WorksheetFunction.Subtotal(3, pf.Offset(1).Resize(pf.Rows.Count - 1, 1)) > 0 Then
    pf.Offset(1).Resize(pf.Rows.Count - 1).EntireRow.Delete
End If
ActiveSheet.ShowAllData: Range("K1:OK2") = ""
End Sub
 

thierry440

XLDnaute Junior
Bonjour

J'essaye d'optimiser échantillon 200 lignes ( 420000) dans fichier source.
le but étant de supprimer les lignes remplissant condition :
colonne 4 : Clôturé
colonne 26 : < 2016

merci d'avance.
 

Fichiers joints

Staple1600

XLDnaute Barbatruc
Bonsoir le fil, le forum

@thierry440
Avant de penser à optimiser, il faudrait d'abord penser à anonymiser non ?
Piqûre de rappel ;)
5 – La possibilité de joindre des fichiers est donnée sur ce forum. Ne pas hésiter à utiliser cette fonction, tout en veillant que les données soient bidons et donc qu’aucune donnée confidentielle, nominative ne soit dans le fichier.
EDITION: Il semblerait que tu n'as pas testé la macro que je t'ai proposée dans mon précédent message, non ?
Pourtant elle fonctionne bien
La voici (ajustée au nouveau fichier)
VB:
Sub test_OK()
Dim pf As Range
With [A1].CurrentRegion
    .Item(2, 28).FormulaR1C1 = "=(RC4=""clôturé "")+(YEAR((""1/1/""&RC26)*1)<2016)=2"
    .AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("AB1:AB2"), Unique:=False
End With
Set pf = [_FilterDataBase]
Application.DisplayAlerts = False
If WorksheetFunction.Subtotal(3, pf.Offset(1).Resize(pf.Rows.Count - 1, 1)) > 0 Then
    pf.Offset(1).Resize(pf.Rows.Count - 1).EntireRow.Delete
End If
ActiveSheet.ShowAllData: Range("AB1:AB2") = ""
End Sub
NB: Avant emploi, remplacer Clôturé par clôturé dans la colonne idoine (grâce à CTRL+H)
 
Dernière édition:

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas