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

66alex66 · 30 Septembre 2022

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 :

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

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.
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.
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 !

sylvanu · 30 Septembre 2022

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 · 30 Septembre 2022

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

66alex66 · 30 Septembre 2022

Un tout grand merci à toi !

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

66alex66

XLDnaute Nouveau

Pièces jointes

sylvanu

sylvanu

XLDnaute Barbatruc

Pièces jointes

66alex66

XLDnaute Nouveau

Discussions similaires