Discussion :

[gwenngeocaz]

Bonjour, je ne sais pas si c'est possible mais j'ai des lignes dans un tableau et je souhaite insérer des lignes le nombre de fois que la valeur indiquée dans la colonne B et copier cette même ligne. Je ne sais pas si je suis clair alors voici un exemple:




Merci d'avance

[Invité]

Bonjour,

A tester :

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
25
26
27
28
29
 
Option Explicit
 
Sub DupliquerLesLignes()
 
Dim I As Long, J As Long, LigneDebut As Long, LigneFin As Long, NbPresents As Long
Dim Liste As Range
 
    With ActiveSheet
         LigneDebut = 3
         LigneFin = .Cells(.Rows.Count, 1).End(xlUp).Row
         Set Liste = .Range(.Cells(LigneDebut, 1), .Cells(LigneFin, 1))
 
         For I = 1 To Liste.Count
            With Liste(I)
                 NbPresents = WorksheetFunction.CountIf(Liste, .Value)
                 If NbPresents < .Offset(0, 1) Then
                    For J = 1 To .Offset(0, 1) - NbPresents
                        .EntireRow.Copy Destination:=ActiveSheet.Cells(LigneFin + 1, 1)
                        LigneFin = LigneFin + 1
                    Next J
                 End If
            End With
         Next I
    End With
 
    Set Liste = Nothing
 
End Sub

[Invité]

S'il faut trier le tableau :

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
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
 
Sub DupliquerLesLignesAvecTri()
 
Dim I As Long, J As Long, LigneDebut As Long, LigneFin As Long, NbPresents As Long
Dim Liste As Range
 
    With ActiveSheet
         LigneDebut = 3
         LigneFin = .Cells(.Rows.Count, 1).End(xlUp).Row
         Set Liste = .Range(.Cells(LigneDebut, 1), .Cells(LigneFin, 1))
 
         For I = 1 To Liste.Count
            With Liste(I)
                 NbPresents = WorksheetFunction.CountIf(Liste, .Value)
                 Debug.Print Liste(I) & " : " & WorksheetFunction.CountIf(Liste, .Value)
                 If NbPresents < .Offset(0, 1) Then
                    For J = 1 To .Offset(0, 1) - NbPresents
                        .EntireRow.Copy Destination:=ActiveSheet.Cells(LigneFin + 1, 1)
                        LigneFin = LigneFin + 1
                    Next J
                 End If
            End With
         Next I
 
         ' Tri du tableau
         TrierUnTableau ActiveSheet, LigneDebut, 1
 
    End With
 
    Set Liste = Nothing
 
End Sub
 
Sub TrierUnTableau(ByVal FeuilleATrier As Worksheet, ByVal LigneDeTitre As Long, ByVal ColonneATrier As Long)
 
Dim DerniereColonne As Long
Dim DerniereLigne As Long
 
Dim AireATrier As Range
Dim AireColonne As Range
 
    With FeuilleATrier
 
         DerniereColonne = .Cells(LigneDeTitre, .Columns.Count).End(xlToLeft).Column
         DerniereLigne = .Cells(.Rows.Count, ColonneATrier).End(xlUp).Row
 
         If DerniereLigne > LigneDeTitre Then
            Set AireATrier = .Range(.Cells(LigneDeTitre, 1), .Cells(DerniereLigne, DerniereColonne))
            Set AireColonne = .Range(.Cells(LigneDeTitre, ColonneATrier), .Cells(DerniereLigne, ColonneATrier))
 
            .Sort.SortFields.Clear
            .Sort.SortFields.Add Key:=AireColonne, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            With .Sort
                 .SetRange AireATrier
                 .Header = xlYes
                 .MatchCase = False
                 .Orientation = xlTopToBottom
                 .SortMethod = xlPinYin
                 .Apply
             End With
 
             Set AireColonne = Nothing
             Set AireATrier = Nothing
 
          End If
 
    End With
 
End Sub

[gwenngeocaz]

Bonjour,

A tester :

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
25
26
27
28
29
 
Option Explicit
 
Sub DupliquerLesLignes()
 
Dim I As Long, J As Long, LigneDebut As Long, LigneFin As Long, NbPresents As Long
Dim Liste As Range
 
    With ActiveSheet
         LigneDebut = 3
         LigneFin = .Cells(.Rows.Count, 1).End(xlUp).Row
         Set Liste = .Range(.Cells(LigneDebut, 1), .Cells(LigneFin, 1))
 
         For I = 1 To Liste.Count
            With Liste(I)
                 NbPresents = WorksheetFunction.CountIf(Liste, .Value)
                 If NbPresents < .Offset(0, 1) Then
                    For J = 1 To .Offset(0, 1) - NbPresents
                        .EntireRow.Copy Destination:=ActiveSheet.Cells(LigneFin + 1, 1)
                        LigneFin = LigneFin + 1
                    Next J
                 End If
            End With
         Next I
    End With
 
    Set Liste = Nothing
 
End Sub

Merci beaucoup c'est presque parfait sauf que ca ne fonctionne pas dans le cas ou les valeurs des cellules de la colonne A sont identique

[Invité]

Le problème est mal posé.

[gwenngeocaz]

Désoler si je me suis mal exprimé, c'est la première fois pour moi sur un forum. Donc je réexplique suivant l'exemple :
Donc je souhaite que la 1ère ligne soit dupliquée 2 fois (valeur de la colonne B) et que la 2ème ligne soit dupliquée 3 fois (valeur de la colonne B) etc..

[yalehaire]

Bonjour

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
 
Sub insertLignes1()
  Dim nlh%, nlb%, nc%, i%, J%
  Dim tmp1, tmp2
  Dim tb()
  nlh = Range("A1").End(xlDown).Row
  nlb = Range("A65000").End(xlUp).Row
  nc = Cells(nlh, Cells.Columns.Count).End(xlToLeft).Column
  For i = nlb To nlh Step -1
    tmp1 = Cells(i, 1).Cells & " " & Cells(i, 2).Cells
    tmp2 = Cells(i - 1, 1).Cells & " " & Cells(i - 1, 2).Cells
 
    If tmp1 <> tmp2 And Cells(i, 2).Cells > 1 Then
      tb = Range(Cells(i, 1), Cells(i, nc)).Cells
      For J = 1 To Cells(i, 2).Cells - 1
        Rows(i).Insert Shift:=xlDown
        Range(Cells(i, 1), Cells(i, nc)) = tb
      Next J
    End If
  Next i
End Sub

[Invité]

Vous ne décrivez pas correctement vos règles de gestion. Quels cas peut-on rencontrer dans la liste initiale ? Y a-t-il des doublons possibles ? Si oui quelle valeur doit être prise en compte s'il y a homonymie ?

[gwenngeocaz]

Excusez moi si je ne suis pas clair mais je ne sais pas quoi dire de plus que le fait que je dois dupliquer chacune des lignes le nombres de fois inscrit dans la cellule de cette ligne sur la colonne B. Chaque ligne peut comporter des cellules identiques aux lignes précédentes. Mais toutes les lignes du tableau de base doivent être dupliquée

[Invité]

Vous ne répondez pas aux questions. Dans votre message d'origine, seulement 2 cas distincts dans votre tableau. Ensuite, vous indiquez que le code ne fonctionne pas lorsqu'il y a deux cas identiques, mais ce cas n'est pas identifié au départ et vous n'indiquez pas ce qui doit être choisi si pour ce cas on a deux valeurs distinctes en colonne B.

Je dois raisonner comme un bourrin... Le mieux est que j'arrête cette discussion, d'autres auront mieux compris que moi et vous aurez la bonne réponse.

Bonne chance.