Option Explicit
Sub Essai()
Dim n1&: n1 = Cells(Rows.Count, 1).End(3).Row: If n1 = 1 Then Exit Sub
Dim T, QM%, QT%, QA#, PU#, MT#, ref$, mvt$, n2&, i&, j&
Application.ScreenUpdating = 0: Range("E:E, G:H").Columns.ClearContents
[E1] = "stock restant": [G1] = "PMP": n1 = n1 - 1: T = [A2].Resize(n1, 8)
Do
'recherche d'une 1ère référence
ref = "": i = 1
Do
If ref = "" And T(i, 8) = 0 And T(i, 1) = "achat" Then
ref = T(i, 3): QT = T(i, 4): T(i, 5) = QT: QA = QT: PU = T(i, 6)
MT = QT * PU: T(i, 8) = 1: n2 = n2 + 1: j = i + 1
Else
i = i + 1
End If
Loop Until i > n1
'traitement de toutes les lignes de la 1ère référence ci-dessus
For i = j To n1
If ref <> "" And T(i, 3) = ref And T(i, 8) = 0 Then
mvt = T(i, 1): QM = T(i, 4)
If mvt = "achat" Then
QT = QT + QM: MT = MT + QM * T(i, 6): QA = QA + QM
If QA <> 0 Then PU = Round(MT / QA, 5)
Else
QT = QT - QM: T(i, 7) = PU
End If
T(i, 5) = QT: T(i, 8) = 1: n2 = n2 + 1
End If
Next i
Loop Until n2 = n1
[E2].Resize(n1) = Application.Index(T, Evaluate("Row(" & "1:" & n1 & ")"), 5)
[G2].Resize(n1) = Application.Index(T, Evaluate("Row(" & "1:" & n1 & ")"), 7)
End Sub