Insertion de ligne en fonction d'une variable

Version imprimable

13/12/2023, 18h00
eric4459

2 pièce(s) jointe(s)

Insertion de ligne en fonction d'une variable

Bonjour à tous,
J'ai un tableau dans lequel je voudrais inserer des ligne vides en fonction d'un nombre indiqué dans l'une des colonnes

Pièce jointe 647790
En colonne no4 (Number of CWP) j'ai des chiffres, sous chacune des lignes je souhaiterais inserer autant de lignes que le nombre indiqué dans cette colonne.
Pour chacune des lignes inserées je souhaiterais les numéroter de 1 au nombre de ligne insérées comme ci-dessous

Pièce jointe 647791
Merci d'avance pour vos conseils et votre support

Eric

Salut, voici qui fait le job:

Code:

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
Sub InsertRows()
    Dim rng As Range
    Dim i As Long
    Dim num As Long
    Dim arr() As Variant
    Dim j As Long
    Dim ws As Worksheet
 
    'Définir la feuille de travail
    Set ws = ThisWorkbook.Sheets("Feuil1")
 
    ' Définir la plage comme colonne D
    Set rng = ws.Range("D2:D" & ws.Cells(Rows.Count, "D").End(xlUp).Row)
 
    Application.ScreenUpdating = False
 
    ' Parcourir la plage à l'envers
    For i = rng.Rows.Count To 1 Step -1
        ' Obtenir le nombre de lignes à insérer
        num = rng.Cells(i, 1).Value
 
        ' Insérer les lignes et numéroter en colonne A
        If num > 0 Then
            rng.Cells(i + 1, 1).Resize(num).EntireRow.Insert
            ReDim arr(1 To num)
            For j = 1 To num
                arr(j) = j
            Next j
            Range("A" & rng.Cells(i, 1).Row + 1 & ":A" & rng.Cells(i, 1).Row + num).Value = Application.Transpose(arr)
        End If
    Next i
    Application.ScreenUpdating = True
End Sub

Salut,
Avec l'utilisation d'un tableau structuré, bien entendu tu doit insérer le tableau structuré et le nommer.

Code:

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
Public Sub InsertRows()    Dim MonTableau As ListObject
    ' // Adaptez le nom de la feuille ainsi que le nom du tableau
    Set MonTableau = Feui1.Range("MonTableau").ListObject
 
    Dim TotalRows As Long
    TotalRows = MonTableau.ListRows.Count
 
    Dim RowItemIndex As Long
    For RowItemIndex = TotalRows To 1 Step -1
        Dim RowItem As ListRow
        Set RowItem = MonTableau.ListRows(RowItemIndex)
 
        Dim insertedRowNumber As Long
        insertedRowNumber = CLng(RowItem.Range(MonTableau.ListColumns.Item("Number of CWP").Index).Value)
        If insertedRowNumber > 0 Then
            Dim Counter As Long
            For Counter = 1 To insertedRowNumber
                Dim NewRow As ListRow
                Set NewRow = MonTableau.ListRows.Add(RowItem.Index + Counter)
                NewRow.Range(MonTableau.ListColumns.Item("Items").Index).Value = Counter
                Set NewRow = Nothing
            Next Counter
        End If
        Set RowItem = Nothing
    Next RowItemIndex
End Sub

14/12/2023, 11h25
eric4459

2 pièce(s) jointe(s)

Bonjour,
Franc ton code fonctionne parfaitement et fait le job, merci ;)
Jean-Paul
Il doit manquer quelquechose voici une capture du code que j'ai adapté mais qui me dit MonTableau=Nothing

Pièce jointe 647807

Pièce jointe 647808

Je serai intéressé de voir comment corriger cela ;)

Eric
14/12/2023, 13h13
Franc

Salut, j'ai testé avec un tableau structuré et ça fonctionne parfaitement.
Est-ce que le nom de ton listobject est bien "Tableau" et pas autre chose ?
14/12/2023, 13h15
Valtrase
Re,
As-tu créé un tableau et nommé selon les besoins ?
- Sélectionnes la totalité des données que tu veux dans le tableau :
Pièce jointe 647809
- Ensuite menu: Acceuil/Styles/Mettre sous forme d'un tableau
- Sélectionner le format du tableau
- Bien vérifier que Mon tableau comporte des en-têtes soit coché.
- Dans l'onglet création de tableau renommer le tableau "MonTableau", ou autre nom à convenance.
Pièce jointe 647810
- Dans la fonction InsertRow bien vérifier que le nom du tableau et de la feuille sont bons.
Dans mon exemple la feuille et la feuille 1 et le tableau se nomme "MonTableau"

Code:

Set MonTableau = Feuil1.Range("MonTableau").ListObject

re,
Petit complément :

Je te conseille vivement de créer un Pattern Factory pour initialiser les tables de ton projet. cela t'évitera en cas de changement de nom du tableau ou de la feuille, de devoir te peler tout le code pour remplacer les noms...
Exemple :

Tu crée un module "Factory"
Tu insère cette fonction
Code:

1 2 3 4 5 6 7 8 Public Function InitTableActivityBus() As ListObject Static Item As ListObject If Item Is Nothing Then ' // Adapter le nom de la feuille et du tableau ci-dessous Set Item = ThisWorkbook.Worksheets.Item("Mafeuille").Range("MonTableau").ListObject End If Set InitTableActivityBus = Item End Function
Ensuite ailleurs dans le code tu peux initialiser le tableau facilement, exemple dans la procédure InsertRows :

Pièce jointe 647812

14/12/2023, 15h20
eric4459

2 pièce(s) jointe(s)

Jean-Paul,
Je ne vois pas à quoi correspond "Factory"

Pièce jointe 647822

je te joins une copie du fichier car je ne saisis pas

Bonjour

en 2 étapes avec Power Query
Code:

1 2 3 4 5 6 let Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content], Table = Table.AddColumn(Source, "Data", each Table.FromRecords({_}) & Table.FromColumns({{1..[Number of CWP]}}, {"Item"})), Combine = Table.Combine(Table[Data]) in Combine
Vous chargez votre tableau dans Power Query (menu données)
puis vous copiez ces 2 étapes

sinon, vous partez d'une requête vide et vous copiez le code en entier dans l'éditeur avancé.

le principe est d'ajouter une table avec une colonne "Item" = 1, 2, ... n à chaque ligne du tableau initial et de combiner le tout

Stéphane

14/12/2023, 16h57
Valtrase

Re,
Voici le fichier retravaillé
mets un point d'arrêt sur la ligne :

Code:

Set TableActivityBus = Factory.InitTableActivityBus

dans le module Current.

Ensuite lance la macro depuis la feuille Test_1.
Puis tu avance avec F8 et tu regarde ce qui se passe.

Pièce jointe 647829

:roll: Sur qu'il va falloir que je me penche sur Power Query

Citation:

Envoyé par Valtrase

...

:roll: Sur qu'il va falloir que je me penche sur Power Query

c'est une nécessité d'utiliser VBA et Power Query conjointement. et pour ma part, c'est clairement Power Query qui est loin devant VBA dans mon quotidien (une macro par ci par là, et plusieurs requêtes power query tous les jours)

en une seule étape mais plus complexe
Code:

1 2 3 4 5 let Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content], Data = Table.Combine(List.Transform(Table.ToRecords(Source), each Table.FromRecords({_}) & Table.FromColumns({{1..[Number of CWP]}}, {"Item"}))) in Data
chaque ligne est convertie en enregistrement, et cette liste d'enregistrement est reconvertie en table + ajout des lignes 1..n pour chacune.
et toutes ces tables sont combinées pour reconstituer la vue souhaitée

Stéphane

15/12/2023, 09h08
eric4459

Merci à tous pour votre aide
Eric