Loop Until "" avec une condition If

Bonjour à tous,

Je souhaite automatiser un fichier afin que chaque évènement ne soit plus de telle à telle date mais que la date de début et la date de fin soit la même.

C'est à dire que :

  • si un évènement a lieu du 3 au 5 mars, ma macro va créer deux autres lignes avec les mêmes données, sauf que la première indiquera du 3 au 3, la seconde du 4 au 4 et la troisième du 5 au 5 mars ;
  • si un évènement n'est que sur un jour, alors ma macro passera directement à la ligne suivante.

J'ai réussi à faire la macro me permettant de créer une ligne en dessous en changeant les dates, cependant je n'arrive pas à l'utiliser avec une boucle car à chaque fois elle ne s'arrête pas et je dois forcer excel et quitter.

Sub Insereloop()

vlig = ActiveCell.Row
vzona = vlig & ":" & vlig
vzonb = vlig + 1 & ":" & vlig + 1

Do
If ActiveCell.Value > 0 Then

Selection.EntireRow.Select
Selection.Insert Shift:=xlDown
Rows(vzonb).Select
Selection.Copy
Rows(vzona).Select
ActiveSheet.Paste
Cells(vlig, 3).Select
Selection.Copy
Cells(vlig, 4).Select
ActiveSheet.Paste
ActiveCell.Offset(1, -1).Activate
ActiveCell = ActiveCell + 1
ActiveCell.Offset(0, -2).Activate

If ActiveCell.Value = 0 Then
ActiveCell.Offset(0, 0).Activate

End If
End If

Loop While ActiveCell.Offset(0, 0) <> ""

End Sub

J'ai conscience que mon code est sûrement plus long que ce qu'il pourrait être mais je suis débutante sur VBA et pour l'instant je n'arrive pas à mieux

Merci d'avance de votre aide

8exemple.xlsm (21.90 Ko)

bonjour,

proposition de correction

Sub aargh()
    dl = Cells(Rows.Count, 2).End(xlUp).Row 'nombre de lignes
    For i = dl To 2 Step -1 'on part de la dernière ligne vers la deuxième
        If Cells(i, 3) < Cells(i, 4) Then 'date de debut < date de fin
            nl = Cells(i, 4) - Cells(i, 3) 'nombre de lignes à insérer
            Rows(i + 1 & ":" & i + nl).Insert 'insertion des lignes
            Rows(i).Copy Rows(i + 1 & ":" & i + nl) 'copie de la ligne de base dans l'espace inséré
            For j = 1 To nl + 1 'ajustement des dates
                Cells(i + j - 1, 3) = Cells(i, 3) + j - 1
                Cells(i + j - 1, 4) = Cells(i, 3) + j - 1
            Next j
        End If
    Next i
End Sub

Merci beaucoup de ta réponse, ça marche parfaitement !

Avant de clore le topic, je me demandais si tu pouvais m'expliquer comment fonctionne l'ajustement des dates ? Je n'arrive pas à comprendre ce que représente le j, sachant que tu as mis j=1 mais que le calcul suivant dit i+j-1 donc je ne comprends pas…

Et aussi, est-ce que c'est avec le Step -1 et le Next i que la "boucle" se fait ?

J'espère être suffisamment claire

Merci beaucoup de ta réponse, ça marche parfaitement !

Avant de clore le topic, je me demandais si tu pouvais m'expliquer comment fonctionne l'ajustement des dates ? Je n'arrive pas à comprendre ce que représente le j, sachant que tu as mis j=1 mais que le calcul suivant dit i+j-1 donc je ne comprends pas…

cells(i,3) est la date de départ (date trouvée sur la ligne(=i) qu'on est en train de considérer)

nl est le nombre de lignes que j'ai insérées et pour lesquelles je dois modifier la date.

for j=1 to nl 'je commence une boucle pour modifier nl lignes

i+j-1 me donne le numéro de la ligne à modifier (pour rappel i=numéro de ligne de la ligne considérée)

cells(i+j-1,3) adresse de la cellule dont il faut modifier la date de début

=cells(i,3) + j-1 on y met la date de départ + j-1 jour,

quand j vaut 1 (première ligne à modifier, on met la date de départ+0 jour)

quand j vaut 2 (deuxième ligne à modifier, on met la date de départ+1 jour)

quand j vaut 3 (troisième ligne à modifier, on met la date de départ+2 jours)

etc.

cells(i+j-1,4) adresse de la cellule dont il faut modifier la date de fin

=cells(i,3) + j-1 on y met la date de départ + j-1 jour,

quand j vaut 1 (première ligne à modifier, on met la date de départ+0 jour)

etc.

Et aussi, est-ce que c'est avec le Step -1 et le Next i que la "boucle" se fait ?

oui

Merci beaucoup pour ton aide et tes explications !

Rechercher des sujets similaires à "loop until condition"