Extraction de données en fonction d'une date.

Version imprimable

Bonjour tout le monde,

Je me permet de créer un nouveau sujet car je n'ai pas trouvé de réponser à adapter pour ce que j'ai à réaliser.

J'arrive généralement à me débrouiller avec Excel, mais lorsqu'il s'agit du VBA, c'est une autre affaire.
Je comprend globalement les bases, je réussi généralement à traduire et adapter du code que je trouve en fonction de mes besoins, mais là, je me suis retrouvé bloqué.

Je vous explique ma problématique : j'ai une feuille Excel qui regroupe des données avec notamment 2 colonnes de dates qui bornent des interventions (date début / date fin)
Je souhaite pouvoir extraire les lignes d'interventions en comparant la date de fin d'intervention avec la date du jour. Ca permettrait une mise à jour automatique que nous faisons manuellement pour le moment, et ça limiterait également nos impressions de ces listing.

Voici le code que j'ai réussi à mettre en place :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 Sub Extraction() Dim cel As Range Dim source As Range Worksheets("Extraction").UsedRange.Clear 'vide ma feuille de destination Set source = Sheets("Source").Range("B1:K1") 'Initialisation de source avec l'entête de la feuille source With Sheets("Source") For Each cel In .Range("j2:j" & .Range("j" & .Rows.Count).End(xlUp).Row) 'on boucle sur toutes les cellules de J2 à la dernière cellule occupée de la colonne J If cel.Value >= DateAdd("d", -3, Date) Then 'teste la date des cellules en colonne J (date plus grande que la date du jour -3) End If Next End With source.Copy Worksheets("Extraction").Range("A1") 'on copie d'un coup les cellule de la condition du dessus dans la feuille de destination Worksheets("Extraction").Activate Worksheets("Extraction").Range("A1").Select End Sub
J'ai bien la ligne d'en-tête qui s'affiche, mais je n'ai aucune ligne qui s'affiche en dessous alors qu'elles répondent à ma condition.

Est-ce que quelqu'un voit pourquoi ?
D'avance merci pour les informations que vous pourrez me donner pour me permettre de faire fonctionner complètement cette macro.

Je suis désolé de ne pas pouvoir mettre de print, mais les données sur lesquelles je travaille sont confidentielles.

29/01/2019, 10h56
Trystan441

Bonjour,

Je dis peut être bêtise mais dans ton bloc if, tu n'as aucune ligne après le "then" donc li ne se passera rien quoi qu'il arrive.

Et, à mon avis, tu devrais fonctionner avec des filtres plutôt qu'avec une boucle.
Ca te permettrait d'écarter les lignes que tu n'as pas besoin et de copier tous d'un coup sans utiliser de boucle.
29/01/2019, 11h01
Philippe Tulliez

Bonjour,

Citation:

Je souhaite pouvoir extraire les lignes d'interventions en comparant la date de fin d'intervention avec la date du jour. Ca permettrait une mise à jour automatique que nous faisons manuellement pour le moment, et ça limiterait également nos impressions de ces listing.

Ce que tu souhaites faire d'après ma lecture de ta demande, c'est d'exporter des données suivant conditions

Je ne peux que te conseiller de t'intéresser au filtre avancé d'excel (en VBA la méthode AdvancedFilter). Le critère se résume à une formule qui doit renvoyer VRAI ou FAUX et ensuite cela prend une ligne de code après avoir déclarer les plages de cellules concernées

A lire le cas échéant Les filtres avancés ou élaborés dans Excel
30/01/2019, 09h48
Moumoune29
Bonjour et merci du temps que vous m'accordez.

Citation:

Envoyé par Philippe Tulliez

Ce que tu souhaites faire d'après ma lecture de ta demande, c'est d'exporter des données suivant conditions

C'est bien ça.

Citation:

Je ne peux que te conseiller de t'intéresser au filtre avancé d'excel (en VBA la méthode AdvancedFilter). Le critère se résume à une formule qui doit renvoyer VRAI ou FAUX et ensuite cela prend une ligne de code après avoir déclarer les plages de cellules concernées

Je me suis déjà penché sur les filtres avancés que j'ai un mal fou à faire fonctionner par la manière des fonctions. Je ne parle même pas du fait de l'utiliser en vba.
Le fait de faire entre 2 onglets me complique aussi la chose. (même si j'appelle bien depuis l'onglet destination)

De plus, ma condition est un peu particulère. Je souhaite comparer une liste de dates avec la date du jour +/- 3 jours, d'où le bricolage que j'ai essayé de faire avec mon

Code:

If cel.Value > DateAdd("d", -3, Date)

Par contre, je vois effectivement que comme le dit Trystan441, je n'ai rien après le Then : comme c'est une adaptation d'un code qui comprennait des choses concernant des cellules fusionnées et que je n'en ai pas, j'ai supprimé des choses. Cependant, je ne vois pas quelle commande indiquer dans mon Then en sachant qu'en sortie de boucle, selon le code écrit, c'est censé me coller d'un coup mes lignes répondant à la condition.

En bon français, ce serait du :
Code:

1 2 Si la valeur de la cellule dans la colonne date (ma colonne J) est supérieure à la date du jour +3, Alors enregistrer cette ligne et passer à la suivante.
Il faudrait surement que j'ai quelque chose qui dit que quand j'arrive sur une cellule vide dans la colonne J, ma boucle s'arrête et passe alors à la copie de mes données dans mon onglet Extraction.

Code:

source.Copy Worksheets("Extraction").Range("A1")

Une idée sur ce qui pourrait fonctionner ?

1 pièce(s) jointe(s)

voila comment faire pour contrôler date expirée dans 7 jours
à adapter si non revenir avec un test de quelques lignes sans macro

Code:

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
28
29
30
31
32
33
34
35
Sub AlerteNVfeuille()
Dim w1 As Worksheet
Dim w2 As Worksheet
Set w1 = Sheets("feuil1")
Set w2 = Sheets("feuil2")
Dim i As Long
Dim D As Date
Dim j As Integer
 
Application.ScreenUpdating = False
'nettoyer feuille 2 qui recevera les taches à échéance proche
Sheets("feuil2").Range("A:D").Clear
Sheets("feuil2").Cells(2, 1).Resize(1, 4) = Array("Code", "Fournisseur", "Date CDC", "Remarque")
j = 3
Set w1 = Worksheets("feuil1") 'Feuille qui contient les alertes
D = Date
' ********************************* Période d'éssai
For i = 2 To w1.Range("D" & Rows.Count).End(xlUp).Row
p = D - w1.Range("D" & i)
If p >= 0 Then
w2.Cells(j, 1) = w1.Cells(i, "A").Value
w2.Cells(j, 2) = w1.Cells(i, "B").Value
w2.Cells(j, 3) = w1.Cells(i, "D").Value
w2.Cells(j, 4) = "Date CDC expirée !!!"
j = j + 1
End If
 
Next i
 
 
 w2.Activate
 w2.Cells(1, 1) = "Journée du : " & Date & "  SITUATION DANS 7 JOURS"
 w2.Select
 Application.ScreenUpdating = True
End Sub

Bonjour,

Citation:

Je me suis déjà penché sur les filtres avancés que j'ai un mal fou à faire fonctionner par la manière des fonctions. Je ne parle même pas du fait de l'utiliser en vba.
Le fait de faire entre 2 onglets me complique aussi la chose. (même si j'appelle bien depuis l'onglet destination)

L'avantage en utilisant la méthode AdvancedFilter est sa facilité de mise en place pour la partie codification

Exemple 1 (Le plus concis) On nomme au préalable la zone des données (la source), la zone où l'on place les critères, et la cellule (vide) à partir de laquelle on souhaite exporter les données (si l'on souhait exporter toute les colonnes) ou les cellules contenant l'étiquette de la colonne que l'on souhaite exporter (dans le cas d'une exportation partielle)
Code:

1 2 3 4 5 6 7 Sub Exemple_1() ' Supprime les cellules de la feuille cible Range("areaTarget").Worksheet.Cells.Clear ' Exportation des données suivant critères Range("areaData").AdvancedFilter xlFilterCopy, Range("areaCriteria"), Range("areaTarget") ' Copie de la feuille contenant les données exportées vers un nouveau classeur Range("areaTarget").Worksheet.CopyEnd Sub
Temps maximum : Programmation 5 minutes (et j'ai le temps de boire mon café), nommer les cellules 3 minutes

Exemple 2 On ne nomme pas les cellules
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 Sub Exemple_2() ' Déclaration des variables Dim rngData As Range Dim rngCriteria As Range Dim rngTarget As Range ' Attribution des référebces aux variables objets With ThisWorkbook Set rngData = .Worksheets("db").Range("A1").CurrentRegion Set rngCriteria = .Worksheets("Parameter").Range("A1:A2") Set rngTarget = .Worksheets("Export").Range("A1") End With ' Supprime les cellules de la feuille cible rngTarget.Worksheet.Cells.Clear ' Exportation des données suivant critères rngData.AdvancedFilter xlFilterCopy, rngCriteria, rngTarget ' Copie de la feuille contenant les données exportées vers un nouveau classeur rngTarget.Worksheet.Copy ' Set rngData = Nothing: Set rngCriteria = Nothing: Set rngTarget = Nothing
Un petit peu plus de temps de programmation (+/- 10 minutes)
J'ai pris le temps d'un débutant pour les deux exemples

Autre avantage d'utiliser cette méthode. On peux facilement modifier les critères sans toucher au code VBA ce qui rend l'application pérenne et souple quant à sa maintenance.

La zone des critères peut contenir une formule qui renvoie VRAI ou FAUX. C'est ce que l'on appelle un critère calculé

A vous de voir