XL 2019 Comment recopier une ligne autant de fois que la valeur d'une cellule

[nanoux64]

Bonsoir à tous(tes),

Je suis nouvelle dans le forum et j'aurai besoin d'aide pour du codage VBA. Mon problème est relativement simple, mais je ne sais juste pas coder
Dans mon jeu de données, chaque ligne comporte un effectif dans les colonnes : "Nbre distance contact < 25 m (colonne N), Nbre distance contact 25-100 m (colonne O) et Nbre distance contact >100 m (colonne P). Je souhaiterai dans une nouvelle feuille que chaque ligne soit recopiée autant de fois que l'effectif donné pour chacune des 3 colonnes citées dessus, et ceci pour toutes les lignes. L'objectif étant d'avoir l'effectif non plus en donnée dans une cellule mais en nombre de ligne (j'espère être claire)

Par exemple:
Ligne n°1 [...] Nbre distance contact >100 m = 3
--> Ligne n°1 recopiée 3 fois

Pour avoir à la fin 1 ligne = 1 obs/contact avec, au lieu des 3 colonnes "Nbre distance contact", plus qu'une seule colonne "Distance" comportant la distance à laquelle le contact a été fait, c'est à dire, dire pour chaque ligne/observation à quelle colonne elle appartenait

Je souhaite analyser ces données sur un logiciel qui demande ce format là... et avec autant de ligne, la manière "conventionnelle" est très gourmande en temps et en patience, avec un risque trop élevé d'erreur

Vous trouverez en PJ un extrait de mon jdd.xlsx, l'original comporte au total 1362 lignes. La 2nd feuille précise le rendu désiré

Je vous remercie pour vos réponses

 

[job75]

Bonsoir nanoux64, bienvenue sur XLD,

Voyez le fichier joint et cette macro dans le code de la feuille "Résultat" (clic droit sur l'onglet et Visualiser le code) :

Private Sub Worksheet_Activate()
Dim tablo, i&, resu(), j&, n&, k%
tablo = Sheets("Feuil1").[A1].CurrentRegion.Resize(, 19)
ReDim resu(1 To Rows.Count, 1 To 17)
For i = 2 To UBound(tablo)
    For j = 1 To Val(tablo(i, 14))
        n = n + 1
        For k = 1 To 17
            resu(n, k) = tablo(i, IIf(k > 14, k + 2, k))
        Next k
        resu(n, 14) = "<25m"
    Next j
    For j = 1 To Val(tablo(i, 15))
        n = n + 1
        For k = 1 To 17
            resu(n, k) = tablo(i, IIf(k > 14, k + 2, k))
        Next k
        resu(n, 14) = "25-100m"
    Next j
    For j = 1 To Val(tablo(i, 16))
        n = n + 1
        For k = 1 To 17
            resu(n, k) = tablo(i, IIf(k > 14, k + 2, k))
        Next k
        resu(n, 14) = ">100m"
Next j, i
'---restitution---
If FilterMode Then ShowAllData 'si la feuille est filtrée
With [A2] '1ère cellule de destination, à adapter
    If n Then .Resize(n, 17) = resu
    .Offset(n).Resize(Rows.Count - n - .Row + 1, 17).ClearContents 'RAZ en dessous
End With
End Sub

Elle se déclenche quand on active la feuille.

Son exécution est rapide car elle utilise des tableaux VBA.

Bonne nuit.

 

[mapomme]

Bonjour @nanoux64, @job75 ,

J'avais commencé, je publie...

 

[job75]

Bonsoir nanoux64, mapomme, le forum,

Un code plus "ramassé" grâce à la boucle col dans ce fichier (2) :

Private Sub Worksheet_Activate()
Dim tablo, resu(), a, i&, col As Byte, j&, n&, k%
tablo = Sheets("Feuil1").[A1].CurrentRegion.Resize(, 19)
ReDim resu(1 To Rows.Count, 1 To 17)
a = Array("<25m", "25-100m", ">100m")
For i = 2 To UBound(tablo)
    For col = 0 To 2
        For j = 1 To Val(tablo(i, 14 + col))
            n = n + 1
            For k = 1 To 17
                resu(n, k) = tablo(i, IIf(k > 14, k + 2, k))
            Next k
            resu(n, 14) = a(col)
Next j, col, i
'---restitution---
If FilterMode Then ShowAllData 'si la feuille est filtrée
With [A2] '1ère cellule de destination, à adapter
    If n Then .Resize(n, 17) = resu
    .Offset(n).Resize(Rows.Count - n - .Row + 1, 17).ClearContents 'RAZ en dessous
End With
End Sub

A+

 

[Amilo]

Bonjour nanoux64, job75, mapomme, le forum,
Voici une proposition avec Power Query (dans le 2ème onglet),
Cordialement

 

[mapomme]

Bonjour @Amilo ,

 

[Amilo]

Rebonjour ma pomme,
Prenez tous soin de vous,
Cordialement

 

[nanoux64]

Merci infiniment pour vos réponses !!!