Microsoft 365 Supprimer des lignes en VBA

[Boubie]

Bonjour à tous,

Je cherche à exclure uniquement les éléments A et B de ma base de données ayant une date comptable inférieur au 01/03/2022.

Quelqu'un peut il m'aider, svp. Je souhaiterai utiliser la boucle FOR/NEXT.

Merci d'avance.

 

[gbinforme]

Bonjour,
Voici ta fonction encodée.
Bon test

 

[Dranreb]

Bonjour.
Au plus simple :

Option Explicit
Sub Supprimer()
   Dim LOt As ListObject, T(), L&
   Set LOt = [Tableau14].ListObject
   T = LOt.ListColumns("Date comptable").DataBodyRange.Value
   For L = UBound(T, 1) To 1 Step -1
      If T(L, 1) < #3/01/2022# Then LOt.ListRows(L).Delete
      Next L
   End Sub

 

[Boubie]

Bonjour Ginforme,
Super, le code fonctionne parfaitement mais supprime tous les élements.

Exemple , les élément C même avant cette date sélectionné ne doivent pas être supprimer.(voir mon fichier joint)
La condition ne concerne que les éléments A et B

Merci pour ton retour si tu peux m'aider de nouveau

 

[gbinforme]

La condition ne concerne que les éléments A et B

Curieux comme procédure
alors regarde comme ceci

 

[job75]

Bonjour le forum,

Une solution sans boucle avec le filtre avancé :

Sub Filtre()
Dim P As Range, nlig&
Application.ScreenUpdating = False
[F2] = "=OR(B2=""A"",B2=""B"")*(D2>DATEVALUE(""28/02/2022""))" 'critère
With [A1].CurrentRegion
    .AdvancedFilter xlFilterCopy, [F1:F2], [Z1] 'filtre avancé copié en Z1
    [F2] = ""
    Set P = [Z1].CurrentRegion
    nlig = P.Rows.Count
    P.Copy .Cells(1)
    P.Clear
    If .Rows.Count > nlig Then .Rows(nlig + 1 & ":" & .Rows.Count).Delete xlUp
End With
End Sub

A+

 

[Boubie]

Bonjour Job75,

Ton code fonctionne bien mais supprime tous les lignes.

Mon soucis est que je dois garder dans ma base de données les éléments C par exemple même avant le 28/02/2022? Seul les éléments A et B doivent être exclus?

 

[Dranreb]

On n'appelle pas ça des suppression ni des exclusions, alors, mais des effacements de valeurs. Vous pouvez pour ça affecter aux cellules concernées la valeur Empty.

 

[job75]

Mon soucis est que je dois garder dans ma base de données les éléments C par exemple même avant le 28/02/2022? Seul les éléments A et B doivent être exclus?

Il suffit de modifier le critère de filtrage :

Sub Filtre()
Dim P As Range, nlig&
Application.ScreenUpdating = False
[F2] = "=AND(B2<>""A"",B2<>""B"")+(D2>DATEVALUE(""28/02/2022""))" 'critère
With [A1].CurrentRegion
    .AdvancedFilter xlFilterCopy, [F1:F2], [Z1] 'filtre avancé copié en Z1
    [F2] = ""
    Set P = [Z1].CurrentRegion
    nlig = P.Rows.Count
    P.Copy .Cells(1)
    P.Clear
    If .Rows.Count > nlig Then .Rows(nlig + 1 & ":" & .Rows.Count).Delete xlUp
End With
End Sub

 

[Boubie]

Il suffit de modifier le critère de filtrage :

Sub Filtre()
Dim P As Range, nlig&
Application.ScreenUpdating = False
[F2] = "=AND(B2<>""A"",B2<>""B"")+(D2>DATEVALUE(""28/02/2022""))" 'critère
With [A1].CurrentRegion
    .AdvancedFilter xlFilterCopy, [F1:F2], [Z1] 'filtre avancé copié en Z1
    [F2] = ""
    Set P = [Z1].CurrentRegion
    nlig = P.Rows.Count
    P.Copy .Cells(1)
    P.Clear
    If .Rows.Count > nlig Then .Rows(nlig + 1 & ":" & .Rows.Count).Delete xlUp
End With
End Sub

J'ai adapté ton code et cela me supprime toutes les ligne sauf une.

Ci-joint mon vrai fichier de travail "allégé car j'ai des milliers de lignes en vrai

du coup, l'Elément A correspond en réalité à "E233/084281/IANYM" dans ma BDD

Et Elément B correspond à "E233/084281/IPHELECN4C"

Je ne trouve pas mon erreur par rapport à ton code ?

 

[gbinforme]

Bonjour,
Comme ceci, cela correspond à ton désir ?

 

[job75]

La zone de critère (F2) ne doit pas être dans le tableau, mettez-la en L2.

Et les dates sont en colonne J.

Par ailleurs vous utilisez le critère "E233/084281/IPHELECN4M" je pense qu'il faut le remplacer par "E233/084281/IPHELECN4C" puisque c'est ce qu'il y a dans le tableau :

Sub FiltreMG()
Dim P As Range, nlig&
Application.ScreenUpdating = False
[L2] = "=AND(D2<>""E233/084281/IANYM"",D2<>""E233/084281/IPHELECN4C"")+(J2>DATEVALUE(""28/02/2022""))" 'critère
With [A1].CurrentRegion
    .AdvancedFilter xlFilterCopy, [L1:L2], [Z1] 'filtre avancé copié en Z1
    [L2] = ""
    Set P = [Z1].CurrentRegion
    nlig = P.Rows.Count
    P.Copy .Cells(1)
    P.Clear
    If .Rows.Count > nlig Then .Rows(nlig + 1 & ":" & .Rows.Count).Delete xlUp
End With
End Sub

 

[Boubie]

Ton code fonctionne bien et va m'aider énormément ... Vraiment merciiiiii beaucoup