Discussion :

[minoslha]

Bonjour à Tous,

j'ai un fichier de données que vous trouverez en pieces jointes.
le but cherché est de supprimer par macro les lignes dont la date en colonne D est vide ou inferieure à la date d'aujourd'hui
pour cela j'ai écrit ceci en VBA :
le filtre personalisé :date vide est bien pris en compte mais pas le deuxième critère (inf à la date d'aujourd'hui).
j'ai essayé d'inverser les deux criteres, le problème est le même. il ne prends en compte que le critère 2

Quelqu'un peut il m'aider à résoudre ce problème

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Sub SupprDonnéesInutiles()
    ActiveSheet.Cells.AutoFilter Field:=4, Criteria1:="<" & Date, Operator:=xlOr, Criteria2:="="
    For Each c In [_filterdatabase].Offset(1).Resize(, 1).SpecialCells(xlCellTypeVisible)
        LigFiltrée = c.Row: Exit For
    Next c
    ActiveSheet.Rows("" & LigFiltrée & ":" & LigFiltrée & "").Select
    ActiveSheet.Range(Selection, Selection.End(xlDown)).Delete Shift:=xlUp
    ActiveSheet.Cells.AutoFilter Field:=4
End Sub

[BENNASR]

bonsoir
je suis débutant en VBA et j'ai lu sur ce forum que c'est mieux d'utiliser les filtres élaborés
mais à mon niveau de débutant je travaille avec ça :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub SupprDonnéesInutiles()
Dim plage As Range
Dim DernLigne As Long
DernLigne = Sheets("feuil1").Range("A" & Rows.Count).End(xlUp).Row
Set plage = Sheets("feuil1").Range("D2:D" & DernLigne)
With Sheets("feuil1")
For Each cell In plage
If cell.Value < Date or cell.Value="" Then
cell.Select
Selection.EntireRow.Delete
   End If
   Next cell
   End With
End Sub

[Patrice740]

bonsoir
je suis débutant en VBA et j'ai lu sur ce forum que c'est mieux d'utiliser les filtres élaborés
mais à mon niveau de débutant je travaille ...

Quand tu supprimes des cellules dans une boucle, il faut toujours partir de la fin vers le début.
Par exemple :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Option Explicit
Sub SupprDonnéesInutiles()
Dim cel As Range
  Set cel = Worksheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Offset(0, 3)
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  Do While cel.Row > 1
    If cel.Value < Date Or cel.Value = "" Then
      Set cel = cel.Offset(-1)
      cel.Offset(1).EntireRow.Delete
    Else
      Set cel = cel.Offset(-1)
    End If
  Loop
  Application.Calculation = xlCalculationAutomatic
  Application.ScreenUpdating = True
End Sub

Re,

Ou bien, avec un filtre élaboré :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Sub SupprDonnéesFiltrées()
Dim rngDonnees As Range
Dim rngCritere As Range
 
  Set rngDonnees = Worksheets("Feuil1").Range("a1").CurrentRegion
  Set rngCritere = Worksheets("Critères").Range("a1").CurrentRegion
  rngDonnees.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=rngCritere
  rngDonnees.Offset(1).SpecialCells(xlCellTypeVisible).Delete (xlUp)
  If Worksheets("Feuil1").FilterMode Then Worksheets("Feuil1").ShowAllData
 
End Sub

Ton fichier avec l'exemple précédent et avec un filtre élaboré ci-dessus (au choix) :

[vinc_bilb]

Bonjour,

Je fais une petite suggestion: c'est vraiment dommage de basser par un filtre (très bien) pour avoir une boucle super lente après sous la forme

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Do While cel.Row > 1
    If cel.Value < Date Or cel.Value = "" Then
      Set cel = cel.Offset(-1)
      cel.Offset(1).EntireRow.Delete
    Else
      Set cel = cel.Offset(-1)
    End If

=> Donc l'approche peut être bien plus rapide:

1. Vous filtrez (en une ou deux fois)
2. Vous supprimer le réultat du filtre en passant par les .SpecialCells(xlCellTypeVisible), en une passe


Voir exemple ci-dessous, à adapter (ou faire une fonction)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Sub Delete_DateRecords()
 
Dim Wsh As Worksheet
Dim SrcRng As Range, DataRng As Range
 
'Initialisation
    Set Wsh = ActiveSheet 'A adapter
 
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = True   'A adapter
    End With
    Set SrcRng = Wsh.Range("A1").CurrentRegion   'à adapter
 
' On filtre sur les valeurs dupliquées
    SrcRng.AutoFilter Field:=4, Criteria1:="TRUE"     '4 = Columne filtrée (à adapter)
 
' On ne prend que les data affichées après le filtre
    Set DataRng = SrcRng.Offset(1, 0).Resize(SrcRng.Rows.Count - 2, SrcRng.Columns.Count).SpecialCells(xlCellTypeVisible) 'On ne garde que la partie résultat du filtre, en enlevant le header
    Debug.Print DataRng.Address
 
 
' Et on efface
    DataRng.Rows.Delete
    SrcRng.AutoFilter Field:=4      ' On reset les filtres
 
End Sub

[Philippe Tulliez]

Bonjour,
Un exemple : Supprimer des lignes suivant critères avec la méthode AdvancedFilter

[minoslha]

Merci pour ta solution. je voulais absolument passer par le filtre personnalisé. Ta solution est beaucoup plus simple. Tu as raison
merci encore

Quand tu supprimes des cellules dans une boucle, il faut toujours partir de la fin vers le début.
Par exemple :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Option Explicit
Sub SupprDonnéesInutiles()
Dim cel As Range
  Set cel = Worksheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Offset(0, 3)
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  Do While cel.Row > 1
    If cel.Value < Date Or cel.Value = "" Then
      Set cel = cel.Offset(-1)
      cel.Offset(1).EntireRow.Delete
    Else
      Set cel = cel.Offset(-1)
    End If
  Loop
  Application.Calculation = xlCalculationAutomatic
  Application.ScreenUpdating = True
End Sub

[unparia]

Bonjour vinc_bilb
Avec une réserve en ce qui concerne l'aptitude de Specialcells de "construire" nativement une plage discontinue dont le nombre d'aires dépasse la moitié de la limite d'un integer.
Mais le cas est rare (un très grand nombre de cellules concernées et réparties de telle manière que le nombre d'aires est alors élevé).