insertion de ligne avec condition

Version imprimable

bonjour , j'essais de creer un programme me permettant pour chaque ligne de mon tableaux pour laquelle une cellule est differente de la meme cellule de la ligne superieur, de copier et d'inserer cette ligne 8 fois en dessous

ex :

li 1 = 1
li 2= 1
li 3 =2
li4= 2

resultat attendu
li 1 = 1
li 2= 1
li 2= 1
li 2= 1
li 2= 1
li 2= 1
li 2= 1
li 2= 1
li 2= 1
li 2= 1
li 3 =2
li4= 2
li4= 2
li4= 2
li4= 2
li4= 2
li4= 2
li4= 2
li4= 2
li4= 2
voici mon programme mais celui-ci ne marche pas :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 Private Sub CommandButton1_Click() Dim i As Integer For i = [468] To [2] Step -1 If Cells(i, 3) <> (Cells(i - 1, 3)) Then Rows(i + 1).Select ElseIf Cells(i, 3) = Cells(i + 1, 3) Then Rows(i & ":" & i).Select Selection.Copy Selection.Insert Shift:=xlDown Rows(i & ":" & (i + 1)).Select Application.CutCopyMode = False Selection.Copy Selection.Insert Shift:=xlDown Rows(i & ":" & (i + 4)).Select Application.CutCopyMode = False Selection.Copy Selection.Insert Shift:=xlDown End If Next i End Sub
merci d'avance pour tout aide qui pourrait m'être apportée.

Cordialement

25/11/2009, 17h21
ucfoutu
Bonjour,

1) commence par indenter ton code (il me dfonne le tournis, sans cette indentation)
2) soit très précis

Citation:

est differente de la meme cellule de la ligne superieur, de copier et d'inserer cette ligne 8 fois en dessous

"en dessous" de quoi, très exactement ? de la ligne en cours ? de la ligne au-dessus ? tout en bas de tout ?
3) à quoi te sert ici ce select dont tu ne fais absolument rien :
Code:

1 2 3 If Cells(i, 3) <> (Cells(i - 1, 3)) Then Rows(i + 1).Select ElseIf .....
4) tu remontesd (c'est bien) du bas vers le haut et compares avec ce qu'il y a au-dessus... bien... mais explique alors ceci : :ccool: :D

Code:

ElseIf Cells(i, 3) = Cells(i + 1, 3) Then

EDIT :
en fait, si tu me mis avec attention et te poses à toi-même les mêmes questions, tu as déjà l'essentiel (pas tout mais presque) de ta solution :lol:

cela peut etre effectivement peut comprehensible

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Private Sub CommandButton1_Click()
   Dim i As Integer
       For i = [468] To [2] Step -1                        
            If Cells(i, 3) <> (Cells(i - 1, 3)) Then
               Rows(i + 1).Select                         
    'si la cellule (i,D) est differente de la cellule (i-1,D), alors ne rien faire et passer à la ligne précédente    
 
                     ElseIf Cells(i, 3) = Cells(i + 1, 3) Then
                         Rows(i & ":" & i).Select
                             Selection.Copy
                            Selection.Insert Shift:=xlDown
                         Rows(i & ":" & (i + 1)).Select
                              Application.CutCopyMode = False
                              Selection.Copy
                             Selection.Insert Shift:=xlDown
                         Rows(i & ":" & (i + 4)).Select
                              Application.CutCopyMode = False
                              Selection.Copy
                              Selection.Insert Shift:=xlDown
'sinon copier la ligne i et l'inserer juste en dessous de la ligne i en 8 exemplaires
            End If
      Next i
End Sub

ca a l'air de marcher de cette facon
merci beaucoup pour ton aide

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Private Sub CommandButton1_Click()
Dim i As Integer
For i = [468] To [2] Step -1
If Cells(i, 3) <> Cells(i - 1, 3) Then
Rows(i & ":" & i).Select
Selection.Copy
Selection.Insert Shift:=xlDown
Rows(i & ":" & (i + 1)).Select
Application.CutCopyMode = False
Selection.Copy
Selection.Insert Shift:=xlDown
Rows(i & ":" & (i + 4)).Select
Application.CutCopyMode = False
Selection.Copy
Selection.Insert Shift:=xlDown
End If
Next i
End Sub