Macro pour identifer les dates périmées

gaara35 · 19 Novembre 2012

Bonjour,

J'aimerais créer un bouton VBA avec macro, lorsque je clique deçu, j'aimerais que excel me remonte automatiquement toutes les dates dépassées par rapport à la date du jour. J'ai juste besoin de la formule à insérer dans la macro, je joints un exemple de mon fichier

La colonne concernée par la macro est "validité agrément"

Merci, si quelqu'un peut m'aider

camarchepas · 19 Novembre 2012

Re : Macro pour identifer les dates périmées

Bonjour Gaara,

Bon , une proposition que j'ai fais il y a pas longtemps , hier je crois et qui fonctionne.

J'ai pas trop le temps d'ouvrir ton fichier.

Regardes si tu arrive à intégrer , sinon reviens vers moi , d'ailleurs si tu y arrives aussi , c'est toujours sympa d'avoir un retour.

Code:

Dim EcartJour as long 
'Cherche est la date du jour soit 
Cherche = date
'Datelue est la date à vérifiée, ceci à mettre à l'intérieur de la boucle de scrutation des occurences
     EcartJour = DateDiff("d", Cherche, DateLue)
       If EcartJour < 0  Then

Modeste geedee · 19 Novembre 2012

Re : Macro pour identifer les dates périmées

Bonsour®

utiliser le filtre personnalisé :

on pourra éventuellement rajouter un bouton :

kjin · 19 Novembre 2012

Re : Macro pour identifer les dates périmées

Salut,

Code:

Sub zzzzzzzz()
Dim dJour#, rngf As Range, rng As Range, i#, j#, texte$
ActiveSheet.AutoFilterMode = False
dJour = Date
Application.ScreenUpdating = False
Range("B6").AutoFilter Field:=5, Criteria1:="<" & dJour
Set rngf = ActiveSheet.AutoFilter.Range
With rngf
    On Error Resume Next
    Set rng = .Offset(1).Resize(.Rows.Count - 1, 5).SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    If Not rng Is Nothing Then
        For i = 1 To rng.Areas.Count
            For j = 1 To rng.Areas(i).Rows.Count
                texte = texte & rng.Areas(i).Cells(j, 2) & " périmé le " & rng.Areas(i).Cells(j, 5) & vbCrLf
            Next
        Next
        MsgBox texte
    Else
        MsgBox "rien à afficher"
        ActiveSheet.AutoFilterMode = False
    End If
End With
ActiveSheet.AutoFilterMode = False
End Sub

A+
kjin

gaara35 · 19 Novembre 2012

Re : Macro pour identifer les dates périmées

kjin à dit:

Salut,

Code:

Sub zzzzzzzz()
Dim dJour#, rngf As Range, rng As Range, i#, j#, texte$
ActiveSheet.AutoFilterMode = False
dJour = Date
Application.ScreenUpdating = False
Range("B6").AutoFilter Field:=5, Criteria1:="<" & dJour
Set rngf = ActiveSheet.AutoFilter.Range
With rngf
    On Error Resume Next
    Set rng = .Offset(1).Resize(.Rows.Count - 1, 5).SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    If Not rng Is Nothing Then
        For i = 1 To rng.Areas.Count
            For j = 1 To rng.Areas(i).Rows.Count
                texte = texte & rng.Areas(i).Cells(j, 2) & " périmé le " & rng.Areas(i).Cells(j, 5) & vbCrLf
            Next
        Next
        MsgBox texte
    Else
        MsgBox "rien à afficher"
        ActiveSheet.AutoFilterMode = False
    End If
End With
ActiveSheet.AutoFilterMode = False
End Sub

A+
kjin

Merci à tous pour votre aide et contribution,

pour la solution que je quote juste au dessus, que faut t-il changer dans la macro pour que l'affichage (boite de dialogue) ce fasse par rapport à ce qui est écrit dans la colonne B et non les info de la colonne c ?

Merci beaucoup pour vos réponses

kjin · 19 Novembre 2012

Re : Macro pour identifer les dates périmées

Re,

gaara35 à dit:
pour la solution que je quote juste au dessus....

Il a un nom, le gars....non ?!

Remplaces colonne 2 par colonne 1

Code:

For j = 1 To rng.Areas(i).Rows.Count
      texte = texte & rng.Areas(i).Cells(j, 1) & " périmé le " & rng.Areas(i).Cells(j, 5) & vbCrLf
 Next

kjin

gaara35 · 19 Novembre 2012

Re : Macro pour identifer les dates périmées

kjin à dit:
Re,

Il a un nom, le gars....non ?!

Remplaces colonne 2 par colonne 1

Code:

For j = 1 To rng.Areas(i).Rows.Count texte = texte & rng.Areas(i).Cells(j, 1) & " périmé le " & rng.Areas(i).Cells(j, 5) & vbCrLf Next

kjin

Merci Kjin de t'occuper de mon problème

Effetivement la modifcation marche bien dans le tableau test que j'ai posté mais dès que je veux reporter cette macro dans mon tableau original, ça me bloque (c'est surement parce que il y a plusieurs lignes de données dans les cellules concernés, pas seulement les lettres a, b, c, d, e, f ?)
Est ce possible de trouver le probleme au vu du fichier joint ?

Merci Kjin!

kjin · 20 Novembre 2012

Re : Macro pour identifer les dates périmées

Re,
La colonne A n'est pas vide !, donc à remplacer par le code suivant

Code:

Sub zzzzzzzz()
Dim dJour#, rngf As Range, rng As Range, i#, j#, texte$
ActiveSheet.AutoFilterMode = False
dJour = Date
Application.ScreenUpdating = False
Range("A15").AutoFilter Field:=6, Criteria1:="<" & dJour
Set rngf = ActiveSheet.AutoFilter.Range
With rngf
    On Error Resume Next
    Set rng = .Offset(1).Resize(.Rows.Count - 1, 5).SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    If Not rng Is Nothing Then
        For i = 1 To rng.Areas.Count
            For j = 1 To rng.Areas(i).Rows.Count
                texte = texte & rng.Areas(i).Cells(j, 2) & " périmé le " & rng.Areas(i).Cells(j, 6) & vbCrLf
            Next
        Next
        MsgBox texte
    Else
        MsgBox "rien à afficher"
        ActiveSheet.AutoFilterMode = False
    End If
End With
ActiveSheet.AutoFilterMode = False
End Sub

A+
kjin

gaara35 · 20 Novembre 2012

Re : Macro pour identifer les dates périmées

kjin à dit:

Re,
La colonne A n'est pas vide !, donc à remplacer par le code suivant

Code:

Sub zzzzzzzz()
Dim dJour#, rngf As Range, rng As Range, i#, j#, texte$
ActiveSheet.AutoFilterMode = False
dJour = Date
Application.ScreenUpdating = False
Range("A15").AutoFilter Field:=6, Criteria1:="<" & dJour
Set rngf = ActiveSheet.AutoFilter.Range
With rngf
    On Error Resume Next
    Set rng = .Offset(1).Resize(.Rows.Count - 1, 5).SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    If Not rng Is Nothing Then
        For i = 1 To rng.Areas.Count
            For j = 1 To rng.Areas(i).Rows.Count
                texte = texte & rng.Areas(i).Cells(j, 2) & " périmé le " & rng.Areas(i).Cells(j, 6) & vbCrLf
            Next
        Next
        MsgBox texte
    Else
        MsgBox "rien à afficher"
        ActiveSheet.AutoFilterMode = False
    End If
End With
ActiveSheet.AutoFilterMode = False
End Sub

A+
kjin

C'est parfait je te remercie beaucoup pour ton aide Kjin !

Macro pour identifer les dates périmées

gaara35

XLDnaute Nouveau

Pièces jointes

camarchepas

XLDnaute Barbatruc

Modeste geedee

XLDnaute Barbatruc

Pièces jointes

kjin

XLDnaute Barbatruc

Pièces jointes

gaara35

XLDnaute Nouveau

kjin

XLDnaute Barbatruc

gaara35

XLDnaute Nouveau

Pièces jointes

kjin

XLDnaute Barbatruc

gaara35

XLDnaute Nouveau

Discussions similaires