Discussion :

[DrDim]

Bonjour,

Je suis nouveau dans la programmation, je suis inscrit dans une petite formation pour adulte.
Et je bloque.
J'ai créé une macro qui va extraire des données d'un autre fichiers et qui les copies dans un autre (avec des filtres, mise en page).
Maintenant j'aimerais rajouter dans cette macro qu'elle me supprime toutes les lignes qui sont différentes de la date du jour.
J'arrive à le faire pour des lignes avec blanc (enfin je crois)

Code :

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

1
2
3
4
5
6
7
Application.ScreenUpdating = False
For i = Range("A65535").End(xlUp).Row To 1 Step -1
If Cells(i, 7).Value = "" Then
Rows(i).Delete
End If
Next i
Application.ScreenUpdating = True

Mais avec la date, je ne trouve pas.
C'est la première question

Un grand merci de votre aide.
JE vous joins aussi le fichier

[Thautheme]

Bonjour DrDim, bonjour le forum,

Peut-ête comme ça avec un filtre :

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
Sub Macro1()
Dim O As Object 'déclare la variable O (Onglet)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne))
Dim PL As Range 'déclare la variable PL (PLage)
Dim PLV As Range 'déclare la variable PLV (PLage Visible)
 
Set O = Sheets("Import données brutes") 'définit l'onglet O
'définit la dernière ligne éditée DL de la colonne 1 (=A) moins la dernière qui contient "Début"...
DL = O.Cells(Application.Rows.Count, 1).End(xlUp).Row - 1
Set PL = Range("A1:A" & DL) 'définit la plage PL
'filtre la colonne A de l'onglet O avec "date différente de la date du jour" comme critère
O.Range("A1").AutoFilter Field:=1, Criteria1:="<>" & Year(Date) & "/ " & Month(Date) & "/" & Day(Date)
Set PLV = PL.SpecialCells(xlCellTypeVisible) 'définit la plage PLV (cellule visibles (non filtrées) de la plage PL)
PLV.EntireRow.Delete 'efface les ligne entières de la plage PLV
Range("A1").AutoFilter 'supprime le filtre automatique
If CDate(Range("A1").Value) <> Date Then Rows(1).Delete 'si la date en A1 n'est pas égale à la date du jour, efface la ligne 1
End Sub

[DrDim]

Merci

C'est presque cela, en fait dans la macro, il ne me laisse que les dates du jour, alors que je voudrais l'inverse.

[Philippe Tulliez]

Bonjour,

C'est presque cela, en fait dans la macro, il ne me laisse que les dates du jour, alors que je voudrais l'inverse.

A moins que nous ne parlions pas la même langue, il me semble que c'est exactement ce que tu as demandé

Maintenant j'aimerais rajouter dans cette macro qu'elle me supprime toutes les lignes qui sont différentes de la date du jour.

Voici une procédure basée sur la méthode AdvancedFilter qui exporte les données vers la feuille nommée Export et qui ensuite détruit les mêmes lignes de la feuille nommée db
Les dates à contrôler dans cet exemple se trouve en colonne I, et la formule contenant les critères va se placer 2 colonnes à droite de la plage des données qui doit avoir la première ligne avec les étiquettes de colonnes

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 CopyAndDeleteByAdvancedFilter()
 ' Déclaration des variables
 Const myFormula As String = "=I2<>TODAY()" ' Critère calculé
 Dim rngSource As Range, rngTarget As Range, rngCriteria As Range, TypeAction As Integer
 ' Attribution des références aux variables objets
 With ThisWorkbook
  Set rngSource = .Worksheets("db").Range("A1").CurrentRegion
  Set rngTarget = .Worksheets("Export").Range("A1")
 End With
 With rngSource: Set rngCriteria = .Offset(columnoffset:=.Column + .Columns.Count).Resize(2, 1): End With
 ' Placement de la formule dans la zone des critères
 With rngCriteria:  .Cells(1) = "formula": .Cells(2) = myFormula: End With
 ' Exportation et destruction des lignes répondant aux critères avec la méthode AdvancedFilter
 rngTarget.Worksheet.Cells.Clear ' Efface la feuille de la zone cible
 For TypeAction = 2 To 1 Step -1 ' Type action = valeur des constantes xlFilterAction pour argument nommé Action
  With rngSource
  .AdvancedFilter TypeAction, rngCriteria, rngTarget
   If TypeAction = xlFilterInPlace Then
   On Error Resume Next
   .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
   .Worksheet.ShowAllData
   On Error GoTo 0
   End If
  End With
 Next
 rngCriteria.Clear: Set rngSource = Nothing: Set rngTarget = Nothing: Set rngCriteria = Nothing
End Sub

Si maintenant ta demande est l'inverse, il faut changer le critère calculé par

Code :

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

=I2=TODAY()

ou

Code :

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

=NOT(I2<>TODAY())

[Thautheme]

Bonjour DrDim, Philippe, bonjour le forum,

Désolé j'avais compris l'inverse...
Remplace :

Code :

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

O.Range("A1").AutoFilter Field:=1, Criteria1:="<>" & Year(Date) & "/ " & Month(Date) & "/" & Day(Date)

par:

Code :

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

O.Range("A1").AutoFilter Field:=1, Criteria1:=xlFilterToday

et

Code :

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

If CDate(Range("A1").Value) <> Date Then Rows(1).Delete 'si la date en A1 n'est pas égale à la date du jour, efface la ligne 1

par

Code :

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

If CDate(Range("A1").Value) = Date Then Rows(1).Delete 'si la date en A1 est égale à la date du jour, efface la ligne 1

[DrDim]

Un tres grand merci pour votre réponse et votre pédagogie.