Discussion :

[Runsh63]

Bonjour,

J'ai un fichier de plusieurs milliers de lignes dans lequel sur une colonne figure un chiffre allant de 2 à 4 ou alors est vide. Mon but : Si la cellule est vide on ne fait rien, si la cellule contient "2", alors je veux insérer une ligne (dans le but futur de dupliquer une fois les infos), si la cellule contient "3", je dois insérer 2 lignes afin de dupliquer deux fois les infos, et ainsi de suite. Comment inclure dans mon programme cette notion : si la cellule G(x) est vide, alors tu ne fais rien, si ce n'est pas vide, insère moi x ligne, x étant le nombre indiqué en G(x) - 1. Comme je suis nul pour expliquer ma problématique, ci joint un fichier comprenant les données telles que je les ai et un onglet avec le résultat voulu.
Je vous remercie d'avance pour votre aide et vous souhaite un bon après-midi.

[jfontaine]

Bonjour,

Je penses que ce post devrait t'aider.
A toi de nous dire

http://www.developpez.net/forums/d12...cellule-ligne/

[Runsh63]

Bonjour Jérôme,

J'imagine que c'est quelque chose du genre qu'il me faut, mais étant une chèvre en VBA, je suis incapable de l'adapter...

Pour dupliquer les valeurs, je m'arrangerai autrement, mais si quelqu'un pouvait m'écrire le code juste pour insérer ces fameuses x lignes, je lui en serai très reconnaissant.
D'avance merci !

[gFZT82]

Bonjour,

Voici un début de solution (un peu à l'arraché )

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Sub Test()
Dim DerLig As Long
    Application.ScreenUpdating = False
    With Worksheets("Données de départ")
        DerLig = .Range("A" & .Rows.Count).End(xlUp).Row
        For i = DerLig To 2 Step -1
            Set c = .Range("G" & i)
            If Not IsEmpty(c) Then
                If IsNumeric(c) Then
                    c.Offset(0, -3).Value = c.Offset(0, -3).Value / c.Value
                    c.Offset(0, -2).Value = c.Offset(0, -2).Value / c.Value
                    c.Offset(0, -1).Value = c.Offset(0, -1).Value / c.Value
                    Set MaPlage = .Range(.Cells(i, "A"), .Cells(i, "F"))
                    For j = 1 To c.Value - 1
                        .Range("G" & i).EntireRow.Insert
                        .Range(.Cells(i, "A"), .Cells(i, "F")) = MaPlage.Value
                    Next j
                    c.ClearContents
                End If
            End If
        Next
    End With
    Application.ScreenUpdating = True
End Sub

Cordialement.

[Runsh63]

Merci gFZT82, c'est exactement ce que je cherchais à faire !
Problème résolu !

[COCONUT2]

salut
Déjà, il faudrait savoir ce qui déclenche l'ajout des lignes:
1/ A chaque changement de valeur (mais pas recommandé)
2/ A partir d'un bouton
3/ à la sortie du fichier
...

Ensuite, tu vas créer une boucle qui va commencer à la premiere ligne que tu veux (Exemple ici 2 car la premiere ligne est une entete) et qui va finir à la derniere ligne renseignée par la fonction cells(60000,5).end(xlup).row. (qu'il faudra revoir à chaque ligne ajoutée.

et à chaque fois qu'il rencontre une case non vide, il va rajouter n-1 ligne par la fonction insert.

Astuces:
1/Comme il y plusieurs milliers de ligne, faire patienter l'utilistaeur par un message de travail par exemple
2/ luis signaler que le travail est terminé par un message de fin
3/ Si l'évenement déclencheur est activé plusieurs fois, il va falloir faire un test pour vérifier si les lignes ont déjà été créées. ou supprimer le nombre de redondance demandées

Ca devrait donc commencer par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
sub ajout_ligne()
for i=2 to cells(60000,5).end(xlup).row 'i est le n° de ligne
      if cells(i,6)>1 then    'si le nombre de redondance est >1 noté en colonne 6
            for k=1 to cells(i,7)-1                  
                  rows(i & ":" & i).insertrow
                  for j=1 to 5 'On va copier les valeurs de cellules col 1 à 5
                          cells(i+1,j)=cells(i,j)
                  next
                  k=k+1
            next
            cells(i,6)="" 'On vide la valeur de redondance
      end if
next
msgbox("Terminé!")
end sub

A tester et corriger
surtout que la macro n'ira pas au bout du tableau puisque des lignes auront été insérées
A toi de corriger mais c'est une bonne base