Microsoft 365 Soustraire tant que valeur supérieure à max

[Harlem_2021]

Bonjour à tous

Je suis nouveau et j'ai cherché pas mal dans les forums. J'ai trouvé un post qui peut me convenir mais j'ai un souci sur la macro. Elle ne traite pas les lignes qui sont créées
https://www.excel-downloads.com/threads/scinder-valeur-et-ajouter-le-restant.20050335/

Mon besoin est le suivant :
Si la colonne F="A" et si la valeur de la colonne J est supérieure à K, alors soustraire la valeur de colonne C pour que la valeur J (Qui est une formule entre B x C) soit inférieure à K.
Une fois J<K, alors copier coller la ligne traitée en dessous en pensant bien à fournir le restant de la ligne C. Il se peut qu'avec le restant de la colonne C la nouvelle ligne en J soit supérieure à K, si c'est le cas faire la même chose pour que J soit inférieure à K et insérer la ligne en dessous. Et faire cela avec toutes les lignes.

J'ai essayé de reprendre le code VBA de Rouge mais il ne traite pas la ligne qu'il a créé alors qu'il se peut que la valeur en J soit toujours supérieure à K.

Sub Scinder_Valeur()
    Dim Derlig As Long, i As Long
    Dim Val_C As Long, Val_D As Long
    Application.ScreenUpdating = False
    Derlig = Sheets("Commande").Range("A" & Rows.Count).End(xlUp).Row
    For i = Derlig To 2 Step -1
        If Cells(i, "F") = "A" And Cells(i, "J") > Cells(i, "K") Then
            Val_C = Cells(i, "C")
            Val_D = Cells(i, "D")
            Do While Cells(i, "J") > Cells(i, "K") And Cells(i, "F") = "A"
                Cells(i, "C") = Cells(i, "C") - 1
            Loop
            Rows(i).Copy
            Rows(i + 1).Insert Shift:=xlDown
            Cells(i + 1, "C") = Val_C - Cells(i, "C")
            Cells(i + 1, "D") = Val_D - Cells(i, "D")
        End If
    Next i
End Sub

J'espère que cela est claire.
J'ai mis le fichier en PJ avec un onglet résultat souhaité

Merci pour votre aide

Harlem

 

[sylvanu]

Bonjour Harlem,
Je pense que le problème vient de la gestion de i.
Vous partez de la fin de la liste et vous décrémentez. Quand vous insérer une ligne, elle le sera en i+1. Or au prochain For vous pointerez sur i-1. Il faut donc repositionner i sur la ligne nouvellement créée.
Essayez cela, le problème devrait être résolu :

            Rows(i).Copy
            Rows(i + 1).Insert Shift:=xlDown
            Cells(i + 1, "C") = Val_C - Cells(i, "C")
            Cells(i + 1, "D") = Val_D - Cells(i, "D")
            i=i+1 ' Repositionnement de i sur la ligne créée.'
        End If

 

[Rouge]

Bonjour,

Essayez ceci

Sub Scinder_Valeur()
    Dim Derlig As Long, i As Long
    Dim Val_C As Long, Val_D As Long
    Application.ScreenUpdating = False
    
Deb:
    Derlig = Sheets("Commande").Range("A" & Rows.Count).End(xlUp).Row
    For i = 2 To Derlig
        If Cells(i, "F") = "A" And Cells(i, "J") > Cells(i, "K") Then
            Val_C = Cells(i, "C")
            Val_D = Cells(i, "D")
            Do While Cells(i, "J") > Cells(i, "K") And Cells(i, "F") = "A"
                Cells(i, "C") = Cells(i, "C") - 1
            Loop
            Rows(i).Copy
            Rows(i + 1).Insert Shift:=xlDown
            Cells(i + 1, "C") = Val_C - Cells(i, "C")
            Cells(i + 1, "D") = Cells(i, "D")
            GoTo Deb
        End If
    Next i
End Sub

Cdlt

 

[Harlem_2021]

Bonjour à vous

Désolé pour le retour tardif.

C'est super !! Tout fonctionne très bien !!

Merci le forum et merci à vous deux Sylvanu et Rouge ^^

bonne journée et bonne année à vous !!!

Harlem