XL 2010 Péremption des produits

[Mody200]

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

 

[sylvanu]

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 :

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

 

[Mody200]

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 :

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]

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