Microsoft 365 Répartir des quantités restantes en fonction des dates d'expiration

mapomme à dit:

Bonjour à tous ,

Une solution par VBA. L'ordre des lignes dans le tableau n'a pas d'importance.
Cliquer sur le bouton "Les soldes " de la feuille "Feuil1".

Le code est dans le module associé à la feuille "Feuil1".

VB:

Sub LesSoldes()
Dim t, tdep, i&, k&, ref, qte

If Me.FilterMode Then Me.ShowAllData
With Intersect(Columns("a:e"), Range("a1").CurrentRegion)
   .Sort key1:=Range("a1"), order1:=xlAscending, Header:=xlYes, _
         key2:=Range("b1"), order2:=xlAscending, _
         key3:=Range("d1"), order2:=xlAscending
   t = Intersect(Columns("a:e"), Range("a1").CurrentRegion)
   ReDim Preserve t(1 To UBound(t), 1 To UBound(t, 2) + 1)
End With
tdep = Intersect(Columns("i:m"), Range("i1").CurrentRegion)
t(1, UBound(t, 2)) = "Solde par lot"
For i = 2 To UBound(t)
   t(i, 6) = t(i, 5)
   If Join(Array(t(i, 1), t(i, 2)), "\") <> ref Then
      ref = Join(Array(t(i, 1), t(i, 2)), "\"): qte = 0
      For k = 2 To UBound(tdep)
         If Join(Array(tdep(k, 1), tdep(k, 2)), "\") = ref Then
            qte = tdep(k, 4)
            Exit For
         End If
      Next k
   End If
   If k <= UBound(tdep) And qte <> 0 Then
      If qte <= t(i, 5) Then
         t(i, 6) = t(i, 5) - qte
         qte = 0
      Else
         qte = qte - t(i, 5)
         t(i, 6) = 0
      End If
   End If
Next i
Range("a1").Resize(UBound(t), UBound(t, 2)) = t
End Sub

Cliquez pour agrandir...

Magcar à dit:

Bonjour ma pomme Mes connaissances en VBA sont malheureusement très limitées, j'ai donc de la difficulté à reproduire votre solution dans mon vrai tableau . Mais merci quand même pour votre réponse !

Cliquez pour agrandir...