Comment générer automatiquement un nombre de lignes en fonction de certaines valeurs

patbej60

XLDnaute Nouveau
Bonjour,

Dans une Feuil1, j'utilise une liste qui comporte n lignes d'utilisateurs. A chaque fois une valeur est définie pour indiquer combien de lignes je vais devoir générer dans une autre feuille pour chacun de ces utilisateurs.

Par exemple ->
Feuil1 :
Utilisateur A ; 2
Utilisateur B ; 5
Utilisateur C ; 1
Utilisateur D ; 0
[...]

Résultat attendu dans la Feuil2 :
Utilisateur A
Utilisateur A
Utilisateur A
Utilisateur B
Utilisateur B
Utilisateur B
Utilisateur B
Utilisateur B
Utilisateur C

Merci pour votre aide.
 

Pièces jointes

  • Classeur1.xls
    13.5 KB · Affichages: 64
  • Classeur1.xls
    13.5 KB · Affichages: 62
  • Classeur1.xls
    13.5 KB · Affichages: 64
Dernière édition:

Efgé

XLDnaute Barbatruc
Re : Comment générer automatiquement un nombre de lignes en fonction de certaines val

Bonjour patbej60 et bienvenu sur le forum,
Pourrais tu nous fournir un fichier exemple, pour que nous puissions voir la structure réelle des données ?
A te re lire.
Cordialement
 

Yaloo

XLDnaute Barbatruc
Re : Comment générer automatiquement un nombre de lignes en fonction de certaines val

Bonjour patbej60, le forum,

Avec ceci

Code:
Sub Test()
Feuil1.Select
j = Feuil2.Range("A65536").End(xlUp).Row + 1
For k = 2 To 5
For i = 1 To Feuil1.Cells(k, 4)
    Feuil2.Cells(j, 1) = Feuil1.Cells(k, 1)
    Feuil2.Cells(j, 2) = Feuil1.Cells(k, 2)
    Feuil2.Cells(j, 3) = Feuil1.Cells(k, 3)
j = j + 1
Next
Next
End Sub

A+
 

Efgé

XLDnaute Barbatruc
Re : Comment générer automatiquement un nombre de lignes en fonction de certaines val

Re patbej60, Bonjour Yaloo,
Une proposition:
VB:
Sub Export()
Dim i&, j&, k&, T(), Tmp()
ReDim Preserve T(1 To 3, 0 To 0)
With Sheets("Feuil1")
    For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
        For j = 1 To .Cells(i, 4)
            ReDim Preserve T(1 To 3, 0 To UBound(T, 2) + 1)
            For k = 1 To 3
                T(k, UBound(T, 2)) = .Cells(i, k)
            Next k
        Next j
    Next i
End With
With Sheets("Feuil2")
    Tmp = .Range(.Cells(1, 1), .Cells(1, 3)).Value
    .Columns("A:C").ClearContents
    .Cells(1, 1).Resize(UBound(T, 2) + 1, 3) = Application.Transpose(T)
    .Range(.Cells(1, 1), .Cells(1, 3)).Value = Tmp
End With
End Sub
Cordialement
 
Dernière édition:

Efgé

XLDnaute Barbatruc
Re : Comment générer automatiquement un nombre de lignes en fonction de certaines val

Re
Une version 2, un peu plus rapide et surtout plus présentable :eek:.
VB:
Sub Export_2()
Dim i&, j&, k&, x&, L&, T(), Plg(), LstRng As Range
With Sheets("Feuil1")
    Set LstRng = .Cells(Rows.Count, 1).End(xlUp).Offset(0, 3)
    x = WorksheetFunction.Sum(.Range("D2:" & LstRng.Address))
    Plg = .Range(.Cells(2, 1), LstRng).Value
End With
 
If x = 0 Then Exit Sub
ReDim T(1 To x, 1 To 3)
For i = LBound(Plg, 1) To UBound(Plg, 1)
    For j = 1 To Plg(i, 4)
        L = L + 1
        For k = 1 To 3
            T(L, k) = Plg(i, k)
        Next k
    Next j
Next i
 
With Sheets("Feuil2")
    .Range(.Cells(2, 1), .Cells(Rows.Count, 3).End(xlUp)(2)).ClearContents
    .Cells(2, 1).Resize(L, 3) = T
End With
End Sub
Cordialement
 

Discussions similaires