XL 2010 Péremption des produits

Mody200

XLDnaute Occasionnel
Bonjour,

J'ai une feuille complexe contenant des centaines de données contenant des produits expirés
Je dois également fournir une liste de produits qui expireront tous les 3, 6 ou 12 mois (période de deux ans). J'ai configuré le formulaire utilisateur, mais je n'arrive pas à obtenir le code permettant de rechercher dans la zone de liste et de la remplir uniquement avec les produits qui expireront. Selon la date ou la période de 3 mois à 12 mois
 

Pièces jointes

  • listbox expired.xlsm
    161.5 KB · Affichages: 10

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Mody,
Un essai en PJ avec ce que j'ai compris.
J'ai créé une feuille Expiration list, il suffit de modifier la date en J1 (jaune) pour remettre la liste à jour.
Cette liste est triée suivant les délais d'expiration croissant. Avec :
VB:
Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Fin: If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, [J1]) Is Nothing Then
        Dim ExpirationDate, T, i, C
        [A2:G10000].ClearContents
        Application.ScreenUpdating = False
        ExpirationDate = Int(Application.EDate(Now, [J1]))  ' Date d'expiration
         T = Sheets("Details").[A1].CurrentRegion           ' Transfert données dans tableau
         For i = 2 To UBound(T)
            If T(i, 5) >= ExpirationDate Then               ' Si date > date d'expiration
                For C = 1 To 6: T(i, C) = "": Next C        ' On vide la ligne
            End If
         Next i
         [A1].Resize(UBound(T, 1), UBound(T, 2)) = T        ' On restitue le tableau et tri sur date ascendante
         [A:F].Resize(UBound(T)).Sort key1:=[E1], order1:=xlAscending, Header:=xlYes
         [G1] = "Expiration"
         DL = Cells(Cells.Rows.Count, "A").End(xlUp).Row
         Range("G2:G" & DL).Formula = "=E2-TODAY()"         ' On calcul le délai dexpiration et on tri dessus
         [A:G].Resize(DL).Sort key1:=[G1], order1:=xlAscending, Header:=xlYes
    End If
Fin:
Application.ScreenUpdating = True
End Sub
 

Pièces jointes

  • listbox expired.xlsm
    129.3 KB · Affichages: 5

Mody200

XLDnaute Occasionnel
Bonjour Mody,
Un essai en PJ avec ce que j'ai compris.
J'ai créé une feuille Expiration list, il suffit de modifier la date en J1 (jaune) pour remettre la liste à jour.
Cette liste est triée suivant les délais d'expiration croissant. Avec :
VB:
Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Fin: If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, [J1]) Is Nothing Then
        Dim ExpirationDate, T, i, C
        [A2:G10000].ClearContents
        Application.ScreenUpdating = False
        ExpirationDate = Int(Application.EDate(Now, [J1]))  ' Date d'expiration
         T = Sheets("Details").[A1].CurrentRegion           ' Transfert données dans tableau
         For i = 2 To UBound(T)
            If T(i, 5) >= ExpirationDate Then               ' Si date > date d'expiration
                For C = 1 To 6: T(i, C) = "": Next C        ' On vide la ligne
            End If
         Next i
         [A1].Resize(UBound(T, 1), UBound(T, 2)) = T        ' On restitue le tableau et tri sur date ascendante
         [A:F].Resize(UBound(T)).Sort key1:=[E1], order1:=xlAscending, Header:=xlYes
         [G1] = "Expiration"
         DL = Cells(Cells.Rows.Count, "A").End(xlUp).Row
         Range("G2:G" & DL).Formula = "=E2-TODAY()"         ' On calcul le délai dexpiration et on tri dessus
         [A:G].Resize(DL).Sort key1:=[G1], order1:=xlAscending, Header:=xlYes
    End If
Fin:
Application.ScreenUpdating = True
End Sub
Merci, ça marche, mais je voulais que ça marche dans la list box, et c'est ce qu'il faut
 

Mody200

XLDnaute Occasionnel
mais je voulais que ça marche dans la list box, et c'est ce qu'il faut

Bonjour,

J'ai une feuille complexe contenant des centaines de données contenant des produits expirés
Je dois également fournir une liste de produits qui expireront tous les 3, 6 ou 12 mois (période de deux ans). J'ai configuré le formulaire utilisateur, mais je n'arrive pas à obtenir le code permettant de rechercher dans la zone de liste et de la remplir uniquement avec les produits qui expireront. Selon la date ou la période de 3 mois à 12 mois
 

Pièces jointes

  • Copy of listbox expired.xlsm
    202.3 KB · Affichages: 2
Dernière édition: