Macro calcul puis ajout de ligneRésolu

Question

Bonjour ,

Je suis dans la réalisation d'un fichier  de vente et je bloque  , j'aurais voulu une petite aide car je ne vois pas comment faire , j'ai réaliser la première partie mais je sais pu quoi faire  après voici mon  résultat , jai un article vendu a une date précise et je calcule le temps de service après l'avoir vendu donc  je fait aujourd&#8217;hui - la date vendu , la formule et ok mais le problème viens quand j'ai plusieurs article  vendu par date je dois ajouter a chaque fois une ligne par article vendu , je bloque sur cette partie , Exemple :   le 23/04/2012 a aujourd&#8217;hui donc 3 jours et je dispose de 5 article vendu ,je voudrais que pour le résultat il m'ajoute 5 lignes avec le résultat 3 , 3 correspond au nombre de jours et 5 au nombre d'article vendu  tout cela dans une colonne et a chaque fois réaliser cela pour les lignes suivantes , je joint mon code qui fonctionne et calcule les jours entre deux dates, j'espere avoir etait bien précis dans mon explication  .

Sub Macro2()


    If IsDate(Range("D2")) = True Then
       
Range("l2").Formula = "=IF(ISERROR(DATEDIF(RC[-8],TODAY(),""d"")),"""",(DATEDIF(RC[-8],TODAY(),""d"")))"
    Range("l2").AutoFill Destination:=Range("l2:l65535")


    Else
  Range("l2").Formula = "=IF(ISERROR(DATEDIF(RC[-7],TODAY(),""d"")),"""",(DATEDIF(RC[-7],TODAY(),""d"")))"
    Range("l2").AutoFill Destination:=Range("l2:l65535")
    End If
End Sub


Cordialement .

NHenry · Accepted Answer

Bonjour, 

Regardes le .Cells(..., ...)
Et une boucle Do/Loop pour trouver la première ligne vide, et c'est bon.

---------------------------------------------------------------------
[list=ordered][*]Pour poser correctement une question et optimiser vos chances d'obtenir des réponses, pensez à lire le règlement CS, celui-ci pour bien poser votre question ou encore celui-ci pour les PFE et autres exercices[*]Quand vous postez un code, merci d'utiliser la coloration syntaxique (3ième icône en partant de la droite : )
[*]En VB.NET pensez à activer Option Explicit et Option Strict (propriété du projet) et à retirer l'import automatique de l'espace de nom Microsoft.VisualVasic (onglet Références dans les propriétés du projet).
[*]Si votre problème est résolu (et uniquement si c'est le cas), pensez à mettre "Réponse acceptée" sur le ou les messages qui vous ont aidés./list
---
Mon site

walyddu59 · Answer

Salut ,

J'ai réussi a faire ce que je voulais je poste le code .
 Sub Macro2()
   
    Application.ScreenUpdating = False
    Dim i, j As Integer
    Dim numligne As Integer



If IsDate(Range("D2")) = True Then 
           

ActiveSheet.Cells(1, 11).Value = "Temps service"
    i = 2

    While IsEmpty(Range("sheet1!A" & i)) = False
        numligne = Range("sheet1!J" & i).Value
        j = i
        Range("K" & i).Formula = "=IF(RC[-1]>0,DATEDIF(RC[-7],TODAY(),""d""),"""")"
        For i = j + 1 To j + numligne - 1
        Rows(j & ":" & j).Select
        Application.CutCopyMode = False
        Selection.Copy
        Rows(i & ":" & i).Select
        Selection.Insert Shift:=xlDown
        Range("K" & i).Formula = "=IF(RC[-1]>0,DATEDIF(RC[-7],TODAY(),""d""),"""")"
        Next i
       Range("A1:K65535").Sort Key1:=Range("K2"), Order1:=xlAscending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Wend

Else
ActiveSheet.Cells(2, 12).Value = "Temps service"
       i = 3

    While IsEmpty(Range("sheet1!A" & i)) = False
        numligne = Range("sheet1!k" & i).Value
        j = i
        Range("L" & i).Formula = "=IF(RC[-1]>0,DATEDIF(RC[-7],TODAY(),""d""),"""")"
        For i = j + 1 To j + numligne - 1
        Rows(j & ":" & j).Select
        Application.CutCopyMode = False
        Selection.Copy
        Rows(i & ":" & i).Select
        Selection.Insert Shift:=xlDown
        Range("l" & i).Formula = "=IF(RC[-1]>0,DATEDIF(RC[-7],TODAY(),""d""),"""")"
        Next i
       Range("A2:L65535").Sort Key1:=Range("L3"), Order1:=xlAscending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Wend
End If
Application.ScreenUpdating = True 'Facultatif
End Sub


Cordialement .

Macro calcul puis ajout de ligne

2 réponses

Votre réponse

Discussions similaires