Transposition et duplication données

Bonjour à tous !

Une proposition très basique via Power Query (complément gratuit Microsoft à installer pour Excel 2010) :

@JFL bonjour et merci pour ta réponse,

J'aurais peut être du le préciser, mais il me faut du VBA. J'ai déjà d'autres macros présentes dans mon fichier, et je n'ai pas la main pour installer des composants sur mon ordinateur au bureau.

Mes excuses pour ce manque de précision de ma part.

Bonjour à tous de nouveau !

Effectivement la précision est d'importance...

Je laisse la main aux spécialistes VBA.

Vous devriez obtenir rapidement une aide appropriée.

Encore désolé pour cet impair et merci malgré tout pour la réponse et le temps passé. C'est fortement apprécié.

Bonsoir Hellsapawn, le forum,

Hello JFL ,

A tester:

Sub test()
 Dim tb, ntb()
 Dim k, i, j
 Dim var

  With Sheets("Data_Brutes")
   If .Cells.Find("*") Is Nothing Then Exit Sub
    tb = .UsedRange.Cells
    k = 0
    ReDim ntb(1 To UBound(tb, 1) * 50, 1 To 3)
     For i = 1 To UBound(tb, 1)
      var = Split(tb(i, 2), " ")
       For j = 0 To UBound(var)
        ntb(k + 1, 1) = CDbl(tb(i, 1))
        ntb(k + 1, 2) = CDbl(var(j))
        ntb(k + 1, 3) = tb(i, 3)
        k = k + 1
       Next j
     Next i
   End With

   With Sheets("Resultats_Attendus")
    If k > 0 Then
    .Columns("A:C").ClearContents
    '.Columns("A:B").NumberFormat = "00"
    .Range("A1").Resize(k, 3) = ntb
    .Activate
    End If
   End With
  Erase tb: Erase ntb: var = ""
End Sub

Cordialement,

Hello @xorsankukai et merci pour ta réponse.

Je teste ça au bureau demain, cependant, je vois l'utilisation du second onglet dans la macro, mais en fait, cet onglet, dans mon fichier original n'existe pas du tout, je l'ai juste mis dans ma pièce jointe pour illustrer ce que je voulais que la macro fasse (j'ai parfois du mal à exprimer clairement ce que je souhaite, donc je fais je fournis un exemple).

Du coup, la macro va t-elle fonctionner si je supprime ce bout là:

 With Sheets("Resultats_Attendus")
    If k > 0 Then
    .Columns("A:C").ClearContents
    '.Columns("A:B").NumberFormat = "00"
    .Range("A1").Resize(k, 3) = ntb
    .Activate
    End If
   End With

?

Merci encore pour la réponse.

Re,

A tester:

Sub test()
 Dim tb, ntb()
 Dim k, i, j
 Dim var

  With Sheets("Data_Brutes")
   'si la feuille est vide, on quitte la procédure
   If .Cells.Find("*") Is Nothing Then Exit Sub
    'définit le tableau tb en fonction des cellules utilisées
    tb = .UsedRange.Cells
    'indice de départ
    k = 0
   'redimensionne le tableau ntb (lignes, colonnes)
    ReDim ntb(1 To UBound(tb, 1) * 50, 1 To 3)
    'boucle sur les lignes du tableau tb
     For i = 1 To UBound(tb, 1)
     'définit le tableau var en fonction de la colonne 2, on splite sur l'espace
      var = Split(tb(i, 2), " ")
      'on boucle sur chaque élément de var
       For j = 0 To UBound(var)
        ntb(k + 1, 1) = CDbl(tb(i, 1)) 'colonne 1 =colonne 1 de tb
        ntb(k + 1, 2) = CDbl(var(j)) 'colonne 2 = élément de var
        ntb(k + 1, 3) = tb(i, 3) 'colonne 3 = colonne 3 de tb
        k = k + 1 'incrémente l'indice
       Next j 'élément suivant de var
     Next i 'ligne suivante

    If k > 0 Then 'si ntb contient des données
    'on efface les colonnes A à C
    .Columns("A:C").ClearContents
    '.Columns("A:B").NumberFormat = "00"  'format nombre 00
    'on inscrit les valeur du tableau ntb à partir de A1
    .Range("A1").Resize(k, 3) = ntb
    '.Columns("A:C").AutoFit 'ajustement auto de la largeur colonne
    .Columns("A:C").ColumnWidth = 12 'largeur colonne 12
    .Columns("A:C").HorizontalAlignment = xlCenter 'centrage horizontal
    End If
   End With
  Erase tb: Erase ntb: var = "" 'on libère la mémoire
End Sub

Pense à créer une copie avant, par prudence...

Cordialement

Re, merci pour la réponse détaillée et commentée. Je teste ça en profondeur demain matin à la première heure au bureau et je reviens donner les résultats ici. Merci encore :)

Hello @xorsankukai et merci encore pour la réponse d'hier car cela fonctionne nickel

Mais forcément, étant totalement étourdi, je viens de me rendre compte (en allant vérifier sur le fichier final qui doit utiliser les données travaillées ici) qu'en fait, j'ai une colonne supplémentaire .

Du coup, j'ai essayé de modifier la macro, mais j'avais forcément du oublier une ligne quelque part parce que même si je n'avais pas de message d'erreur qui me pétait à la tronche (miracle ), ça ne faisait pas le travail attendu .

Après quelques essais, j'ai réussi à corriger le truc, et du coup, ça marche du feu de dieu.

Merci encore.

J'ai joint le fichier si jamais tu veux y jeter un oeil pour voir si j'ai bien tout corrigé.

Bonjour Hellspawn, le forum,

Tout semble OK....seule la config.des colonnes ou tu n'as pas inclue la colonne D...mais bon, ça reste optionnel.

Sub test()
 Dim tb, ntb()
 Dim k, i, j
 Dim var

  With Sheets("Data_Brutes")
   'si la feuille est vide, on quitte la procédure
   If .Cells.Find("*") Is Nothing Then Exit Sub
    'définit le tableau tb en fonction des cellules utilisées
    tb = .UsedRange.Cells 'ou : tb=.range("A1:D"&.usedrange.rows.count)
    'indice de départ
    k = 0
   'redimensionne le tableau ntb (lignes, colonnes)
    ReDim ntb(1 To UBound(tb, 1) * 50, 1 To 4)
    'boucle sur les lignes du tableau tb
     For i = 1 To UBound(tb, 1)
     'définit le tableau var en fonction de la colonne 2, on splite sur l'espace
      var = Split(tb(i, 2), " ")
      'on boucle sur chaque élément de var
       For j = 0 To UBound(var)
        ntb(k + 1, 1) = CDbl(tb(i, 1)) 'colonne 1 =colonne 1 de tb
        ntb(k + 1, 2) = CDbl(var(j)) 'colonne 2 = élément de var
        ntb(k + 1, 3) = tb(i, 3) 'colonne 3 = colonne 3 de tb
        ntb(k + 1, 4) = IIf(tb(i, 4) <> "", CDate(tb(i, 4)), "") 'colonne 4 = colonne 4 de tb
        k = k + 1 'incrémente l'indice
       Next j 'élément suivant de var
     Next i 'ligne suivante

    If k > 0 Then 'si ntb contient des données
    'on efface les colonnes A à C
    .Columns("A:D").ClearContents
    '.Columns("A:B").NumberFormat = "00"  'format nombre 00
    'on inscrit les valeur du tableau ntb à partir de A1
    .Range("A1").Resize(k, 4) = ntb
    .Columns("A:D").ColumnWidth = 12 'largeur colonne 12
    'ou.Columns("A:D").AutoFit 'ajustement auto de la largeur colonne
    .Columns("A:D").HorizontalAlignment = xlCenter 'centrage horizontal
    End If
   End With
  Erase tb: Erase ntb: var = "" 'on libère la mémoire
End Sub

Bonne continuation,

Ah oui, j'avais zappé ce détail, mais comme je l'ai dis...étourdi

Merci encore!