Aide transposition données

Bonjour tout le monde,

J'ai, pour les besoins d'un projet, besoin de "transformer" des informations issues d'une base de données. Ces données sont récupérées sous la forme d'un fichier Excel (qui est celui attaché plus bas) et formatées telles qu'elles sont initialement dans la base.

Afin de pouvoir retravailler ces données par la suite, je dois les transposer de chaque ligne en colonne et venir y accoler les informations provenant d'une autre colonne

Jusque là, j'ai bien réussi à faire fonctionner une macro qui permet de bien préparer mes données avant transposition. J'ai réussi à transposer une première partie des données (ce que l'ont peu voir dans l'onglet "Tests" dans les colonnes D:E.), cependant, je suis en difficulté pour transposer les données (lignes de G2 à J19) à la suite des précédentes (à partir de D11) en respectant le même format et ensuite venir y accoler l'information supplémentaire.

Le fichier joint montre l'état initial des données telles qu'elles sont extraites de la base (onglet données) et le résultat que je souhaiterais obtenir (onglet résultats) et ce que j'ai réussi à coder jusqu'à présent (onglet test).

Je sais comment supprimer les colonnes pour arriver au résultat final, une fois les données "transformées", mais c'est la partie en amont qui me pose des soucis.

Une âme charitable serait elle en capacité de m'aider à poursuivre le développement de cette macro?

Par avance un grand merci pour le temps mis à disposition pour m'aider.

Bonjour,

Sans macro, mais en utilisant Power Query (pour ta version 365), en 1 étape, c'est fait...

Si ça t'intéresse?

Bonjour @cousinhub,

Meaculpa, j'aurais du préciser que c'était pour la version 2010 et pas 365

Re-,

Si version Pro de 2010, possibilité de télécharger l'Add-On gratuit sur le site de µSoft? (toujours dans le cas, "si ça t'intéresse", bien sûr)

Je ne suis pas contre (ça pourrait me servir pour la suite), mais malheureusement je n'ai pas la possibilité d'installer quoique ça soit sur mon poste (environnement de travail professionnel) à l'heure actuelle d'où le fait de faire une macro en vba, mais déjà merci pour avoir pris le temps de regarder mon problème

J'ai réussi à faire qu'une partie des données soit collée à la suite des précédentes, cependant, je n'arrive pas à ce que cette opération se répète jusqu'à ce que la colonne E soit vide. J'ai bien tenté un "if" ou un "do while...loop" mais sans succès.

Quelqu'un pour éclairer ma lanterne svp?

La version du fichier qui contient la macro jusqu'à l'étape où je bloque:

Bonsoir à tous,

Hellspawn, inspire-toi de ceci pour boucler sur la colonne A.

Option Explicit
Sub test()
Dim i As Long, n As Byte, index As Byte
Dim SplitStr As String, TestStr As String
Dim MyArray()
With Sheets("données")
   TestStr = .Cells(1, 2).Value
   n = 3
   For i = 1 To Len(TestStr) Step n
       SplitStr = Mid(TestStr, i, n)
       ReDim Preserve MyArray(index)
       MyArray(index) = SplitStr
       index = index + 1
   Next i
   .Cells(1, 4).Resize(UBound(MyArray) + 1) = .Cells(1, 1).Value
   .Cells(1, 5).Resize(UBound(MyArray) + 1) = Application.Transpose(MyArray)
End With
End Sub

klin89

Bonjour @Klin89,

MERCI!!!!!!!!!!!!!! C'est exactement ce dont j'avais besoin.

Me reste maintenant à trouver comment faire que cela s'applique à toutes les lignes

@Klin89 merci encore pour la solution proposée, cependant, je rencontre un souci dès lors que j'arrive sur une nouvelle référence dans la colonne A (typiquement à partir de la ligne 7 et le problème est le même pour la ligne 13).

J'ai bien réussi à incrémenter

TestStr = .Cells(1, 2).Value

en

TestStr = .Cells(2, 2).Value

et ainsi de suite pour prendre en compte les lignes suivantes, cependant, dès lors que j'arrive à la ligne 7 ou même la 13, la fonction continue de me propager les informations de la ligne 1. Aurais-je oublier de changer une valeur à un endroit? J'ai bien essayé diverses choses, mais j'avoue que là je suis perdu

@modération : sorry si j'ai mal fait de reposter sur un topic déjà solutionné, mais comme le problème est lié, je ne voulais pas ouvrir un autre topic

EDIT: j'avais bien oublié de prendre en compte le changement à faire sur la ligne

.Cells(1, 4).Resize(UBound(MyArray) + 1) = .Cells(1, 1).Value

en changeant par

.Cells(1, 4).Resize(UBound(MyArray) + 1) = .Cells(7, 1).Value

pour avoir la prise en compte des valeurs correspondantes.

Plus qu'à boucler maintenant

Bon, je pensais avoir réussi à solutionner mon problème mais il semblerait que non.

J'arrive bien à ce que la macro vienne me récupérer le contenu des lignes 1, 7 et 13, qu'elle me colle à la suite dans la même colonne les données formatées, cependant, pour je ne sais quelle obscure raison (sans doute parce que je ne dois pas changer un des paramètres où il faut), la macro me duplique les valeurs de la dernière valeur de la colonne A (BR4) sur toute la colonne D plutôt que de me prendre la valeur de chaque ligne (1, 7 et 13).

J'ai dupliqué le code pour faire que la macro réalise l'opération sur toutes les lignes et cela fonctionne parfaitement (il faut que je réussisse encore à trouver comment faire pour ne pas avoir autant de lignes de code car je suis persuadé qu'il doit bien exister un moyen de boucler toute cela), cependant, dès lors que je "décommente"les lignes pour passer au type suivant de la colonne A, il continue à bien réaliser l'opération, cependant, il garde en mémoire le dernier type choisi.

Je ne comprends vraiment pas pourquoi? Est ce parce que j'oublie de déclarer une variable? Est-ce une valeur à remplacer? Une ligne à ajouter? Je suis perdu

Voilà ce que j'ai réussi à faire avec ce que m'a fourni Klin89, mais je me noie

Merci pour votre aide

Bonjour,

Pour info, il y a une soucis dans le dernier fichier que tu as partagé "lg..." au lieu de "106...".
Ton onglet Donnes ne peut pas correspondre a ton onglet Resultat souhaité

Si j'ai bien compris (en repartant du code de Klin89) et avec le fichier de ce message Ton Message

Ajout d'une boucle "For Ligne = 1 to DerLigne"

Option Explicit
Sub test()
Dim i As Long, n As Byte, index As Byte
Dim Ligne, DerLigne, Recap As Integer
Dim SplitStr As String, TestStr As String
Dim MyArray()
With Sheets("données")
    DerLigne = .Cells(Rows.Count, 1).End(xlUp).Row
    For Ligne = 1 To DerLigne
       TestStr = .Cells(Ligne, 2).Value
       n = 3
       For i = 1 To Len(TestStr) Step n
           SplitStr = Mid(TestStr, i, n)
           ReDim Preserve MyArray(index)
           MyArray(index) = SplitStr
           index = index + 1
       Next i
       Recap = .Cells(Rows.Count, 4).End(xlUp).Row + 1
       .Cells(Recap, 4).Resize(UBound(MyArray) + 1) = .Cells(Ligne, 1).Value
       .Cells(Recap, 5).Resize(UBound(MyArray) + 1) = Application.Transpose(MyArray)
    Next Ligne
End With
End Sub

Et pour chaque boucle avec la variable Recap, on vient controler la ligne pour copier a la suite les données déja copié en D:E

A+

Bonjour @Geof52, et merci pour ta réponse.

J'avais modifié les données sur les 3 lignes pour me permettre de voir si les données étaient répliquées ou écrasées, c'était un moyen visuel tout simplement.

Je regarde ta solution de ce pas, mais merci encore pour le temps passé

Bonjour @Geof52, ça fonctionne merci, cependant, j'ai recopié ton code (copié/collé dans mon fichier) et il me duplique chaque ligne 2 fois et commence en ligne 2 sur les colonnes D, E. Est-ce normal?

Merci à toi

J'ai commenté dans ton code la ligne

Recap = .Cells(Rows.Count, 4).End(xlUp).Row + 1

et j'ai remplacé "Recap" par 1 dans les deux lignes suivantes et les lignes ne sont plus dupliquées, cependant, je rencontre de nouveau le problème que c'est le dernier type récupéré de la colonne A qui vient se propager et remplacer les précédents dans la colonne D

Essai comme ça

Option Explicit
Sub test()
Dim i As Long, n As Byte, index As Byte
Dim Ligne, DerLigne, Recap As Integer
Dim SplitStr As String, TestStr As String
Dim MyArray()
With Sheets("données")
    DerLigne = .Cells(Rows.Count, 1).End(xlUp).Row
    For Ligne = 1 To DerLigne
       TestStr = .Cells(Ligne, 2).Value
       n = 3
       For i = 1 To Len(TestStr) Step n
           SplitStr = Mid(TestStr, i, n)
           ReDim Preserve MyArray(index)
           MyArray(index) = SplitStr
           index = index + 1
       Next i
       Recap = .Cells(Rows.Count, 4).End(xlUp).Row + 1
       If Recap -1 = 1 Then Recap = 1
       .Cells(Recap, 4).Resize(UBound(MyArray) + 1) = .Cells(Ligne, 1).Value
       .Cells(Recap, 5).Resize(UBound(MyArray) + 1) = Application.Transpose(MyArray)
       index = 0
    Next Ligne
End With
End Sub

- Il manquait Index = 0 avant de boucler (c'est la raison qu'il y avait les meme lignes)

- Recap trouves la derniere ligne en colonne D pour les nouvelle données de la boucle

Bonsoir tout le monde,

Une autre tentative, toujours à partir du code de Klin89 (),

Option Explicit

Sub test()
 Dim i As Long, n As Byte, index As Byte
 Dim Ligne, DerLigne, Recap As Integer
 Dim SplitStr As String, TestStr As String, nom As String
 Dim tb, MyArray()

  With Sheets("Données")
    tb = .Range("A1:B" & .Range("A" & Rows.Count).End(xlUp).Row).Value
     For Ligne = 1 To UBound(tb, 1)
       TestStr = CStr(tb(Ligne, 2))
       nom = tb(Ligne, 1)
        n = 3
         For i = 1 To Len(TestStr) Step n
          ReDim Preserve MyArray(1 To 2, 1 To index + 1)
           SplitStr = Mid(TestStr, i, n)
            If IsNumeric(SplitStr) Then
             MyArray(1, index + 1) = CDbl(SplitStr)
             MyArray(2, index + 1) = nom
             index = index + 1
            End If
         Next i
      Next Ligne
     If index > 0 Then
     .Range("A1:B" & .Range("A" & Rows.Count).End(xlUp).Row).Delete
     .Range("A1").Resize(index, 2) = Application.Transpose(MyArray)
     .Columns(1).NumberFormat = "0"
     .Columns(2).NumberFormat = "@"
     End If
   Erase tb: Erase MyArray: TestStr = "": nom = ""
  End With
End Sub

Cordialement,

Bonjour à tout le monde,

Merci @Geof52, ton correctif marche nickel chrome!

@xorsankukai merci à toi pour ta solution, elle fonctionne nickel aussi.

Merci à tous les participants, vous m'avez sorti une sacrée épine du pied