XL 2019 Répartition à réaliser sur base d'une condition

66alex66

XLDnaute Nouveau
Bonjour,

Je me permets de solliciter votre aide pour un calcul à réaliser sous VBA.
Le calcul est celui-ci, réaliser une répartition donnée entre 2 dates.

Voici le tableau de base :

EXCEL_lGbh05BMOr.png


Voici le rendu que j'aimerais obtenir via VBA en cliquant sur un bouton (les formules de la colonne E sont à titre indicatives) :

EXCEL_yJkeSB1zLx.png


  1. J'aimerais qu'une soustraction basique s'applique entre les registre HI et LO, jusqu'à ce que la formule détecte dans la colonne A la date affichée dans la cellule G2.
  2. A partir de là, la formule doit appliquer la répartition indiquée dans les colonnes G3 et G4 (dans ce cas, 40% sur le registre HI et 60% sur le registre LO). En résumé, je souhaiterais que le calcul présent dans la colonne E s'applique sur la colonne D.
  3. Enfin, la toute dernière date doit se colorer en jaune tel que sur la capture d'écran.

D'avance, je vous remercie pour votre aide !
 

Pièces jointes

  • Répartition.xlsm
    9.1 KB · Affichages: 4
Solution
Bonjour 66Alex66,
Un essai en PJ avec :
Code:
Sub Calcul()
    Application.ScreenUpdating = False
    Dim HI, LO, Dif, L
    HI = [G3]: LO = [G4]
    [D3] = [C3] - [C1]: [D4] = [C4] - [C2]:
    For L = 5 To Range("A65500").End(xlUp).Row Step 2
        Dif = (Cells(L, "C") - Cells(L - 2, "C") + Cells(L + 1, "C") - Cells(L - 1, "C"))
        Cells(L, "D") = Dif * HI
        Cells(L + 1, "D") = Dif * LO
    Next L
    [A:D].Interior.Color = xlNone
    Ligne = Application.Match(Application.Max([A:A]), [A:A], 0)
    Range("A" & Ligne & ":D" & Ligne + 1).Interior.Color = RGB(255, 255, 0)
End Sub

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour 66Alex66,
Un essai en PJ avec :
Code:
Sub Calcul()
    Application.ScreenUpdating = False
    Dim HI, LO, Dif, L
    HI = [G3]: LO = [G4]
    [D3] = [C3] - [C1]: [D4] = [C4] - [C2]:
    For L = 5 To Range("A65500").End(xlUp).Row Step 2
        Dif = (Cells(L, "C") - Cells(L - 2, "C") + Cells(L + 1, "C") - Cells(L - 1, "C"))
        Cells(L, "D") = Dif * HI
        Cells(L + 1, "D") = Dif * LO
    Next L
    [A:D].Interior.Color = xlNone
    Ligne = Application.Match(Application.Max([A:A]), [A:A], 0)
    Range("A" & Ligne & ":D" & Ligne + 1).Interior.Color = RGB(255, 255, 0)
End Sub
 

Pièces jointes

  • Répartition.xlsm
    17 KB · Affichages: 7

Discussions similaires

Réponses
10
Affichages
302

Statistiques des forums

Discussions
314 496
Messages
2 110 235
Membres
110 708
dernier inscrit
novy16