macro qui supprime les lignes suivant conditions

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

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
 
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:
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

  • Question Question
Microsoft 365 Formule Excel
Réponses
4
Affichages
246
Réponses
8
Affichages
883
  • Question Question
Microsoft 365 formule addition
Réponses
4
Affichages
114
Réponses
1
Affichages
168
Retour