Option Base 1
Sub RepartitionPalette()
' suppression
Range(Cells(2, 14), Cells(Cells(65536, 1).End(xlUp).Row, 14)).ClearContents
Dim TabBd As Variant
TabBd = Range(Cells(2, 1), Cells(Cells(65536, 1).End(xlUp).Row, 4))
ReDim Preserve TabBd(LBound(TabBd, 1) To UBound(TabBd, 1), LBound(TabBd, 2) To 5)
' Inventaire référence
For i = LBound(TabBd, 1) To UBound(TabBd, 1)
For j = LBound(TabBd, 1) To UBound(TabBd, 1)
If TabBd(i, 2) = TabBd(j, 2) Then
TabBd(i, 5) = TabBd(i, 5) + TabBd(j, 3)
End If
Next j
Next i
' Tableau référence
ReDim Preserve TabBd(LBound(TabBd, 1) To UBound(TabBd, 1), LBound(TabBd, 2) To 6)
For i = LBound(TabBd, 1) To UBound(TabBd, 1)
If TabBd(i, 4) = 0 Then
Cells(i + 1, 14) = TabBd(i, 4)
ElseIf TabBd(i, 5) > TabBd(i, 4) Then
TabBd(i, 6) = TabBd(i, 5)
TabBd(i, 5) = TabBd(i, 5) - TabBd(i, 4)
Cells(i + 1, 14) = TabBd(i, 5)
TabBd(i, 5) = TabBd(i, 6) - TabBd(i, 5)
For j = i + LBound(TabBd, 1) To UBound(TabBd, 1)
If TabBd(i, 2) = TabBd(j, 2) Then
TabBd(j, 5) = TabBd(i, 5)
End If
Next j
ElseIf TabBd(i, 5) <= TabBd(i, 4) Then
TabBd(i, 6) = TabBd(i, 5)
Cells(i + 1, 14) = TabBd(i, 6)
For j = i + LBound(TabBd, 1) To UBound(TabBd, 1)
If TabBd(i, 2) = TabBd(j, 2) Then
TabBd(j, 5) = 0
End If
Next j
End If
Next i
End Sub