Sub TotalAchatCond()
Dim DerLignea&, DerLigneb&, Résultat&, i&, j&
DerLignea = Range("C" & Rows.Count).End(xlUp).Row
DerLigneb = Range("F" & Rows.Count).End(xlUp).Row
a = Range("C2:C" & DerLignea)
b = Range("F2:F" & DerLigneb)
For i = 2 To DerLigneb
For j = 2 To DerLignea
If Cells(j, 2) = b(i - 1, 1) Then
If Cells(j, 4) > 500 Then
Résultat = Résultat + Cells(j, 4)
End If
End If
Next j
Dim c()
ReDim Preserve c(1 To UBound(b))
c(i - 1) = Résultat
Résultat = 0
Next i
Range("L2:L" & DerLigneb) = Application.Transpose(c)
End Sub