Ecretage et valeur max variable

[LaurentOASIIS]

Bonjour,
Je sèche sur un problème d’écrêtage de valeur.
Je dois écrêter des séries de valeurs, pour limiter la valeur maximum. Pour ce faire je dispose de 7500 unités que je peux répartir comme bon me semble. Ces 7500 unités me sont disponibles tous les jours.
Dans la pièce jointe, il y a une série pour une journée en question, j’ai bien essayé plusieurs solutions mais en vain 😡, si quelqu’un sait me dépanner je lui en serais très reconnaissant. Cette opération doit être répétée pour les 365 jours de notre chère année, mais, une fois la formule en main je pense être capable de l’étirer sur toute l’année.

Encore merci.

 

[job75]

Re : Ecretage et valeur max variable

Bonjour Laurent, CISCO, le forum,

Finalement il me paraît inutile d'exécuter Valeur cible pour tous les jours.

Avec une seule macro qui traite juste la date entrée en E7 :

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$E$7" Then Exit Sub
Dim i As Variant
i = Application.Match([E7], [A:A])
If IsError(i) Then Exit Sub
Application.ScreenUpdating = False
Range("D34:H" & Rows.Count).ClearContents 'RAZ
[D10:H33].Copy Cells(i, "D")
Cells(i, "G") = 0
If Cells(i, "D") > 7500 Then _
  Cells(i, "D").GoalSeek Goal:=7500, ChangingCell:=Cells(i, "G")
Application.Goto Cells(i, 1), True
With Me.ChartObjects(1)
  .Top = Cells(i, "I").Top
  .Left = Cells(i, "I").Left
  .Chart.ChartTitle.Characters.Text = "Ecrétage " _
    & Format(Cells(i, 1), "dd/mm/yyyy")
End With
End Sub

Fichier (4).

A+

 

[job75]

Re : Ecretage et valeur max variable

Re,

Les solutions précédentes n'allaient pas 😡

Il faut déterminer 2 maxima : un pour les "PTE" en G10 puis un pour les "HP" en G11 :

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [E7,C:C]) Is Nothing Then Exit Sub
Dim i As Variant
i = Application.Match([E7], [A:A])
If IsError(i) Then Exit Sub
Application.ScreenUpdating = False
Range("D34:H" & Rows.Count).Delete xlUp 'RAZ
[D10:H33].Copy Cells(i, "D")
Cells(i, "G").Resize(2) = 0
If Cells(i, "D") > 7500 Then _
  Cells(i, "D").GoalSeek Goal:=7500, ChangingCell:=Cells(i, "G")
If Cells(i + 1, "D") > 7500 Then _
  Cells(i + 1, "D").GoalSeek Goal:=7500, ChangingCell:=Cells(i + 1, "G")
Application.Goto Cells(i, 1), True
Target.Select
With Me.ChartObjects(1)
  .Top = Cells(i, "I").Top
  .Left = Cells(i, "I").Left
  .Chart.ChartTitle.Characters.Text = "Ecrétage " _
    & Format(Cells(i, 1), "dd/mm/yyyy")
End With
End Sub

J'ai revu toutes les formules en colonnes D E F.

Fichier (5).

A+