Créer une liste à partir de données verticales et horizontales

Bonjour,

Si vous avez deux petites minutes, vous grand maîtres du VBA, Je cherche une petit truc pour créer automatiquement une liste à partir de données listées verticalement avec des données s'y rattachant horizontalement.

Je sais, si vous regardez le fichier joint, vous aurez une meilleure idée de ma demande.

VOus comprendrez que mon exemple N,a que quelques lignes et 4colonnes mais que le vrai travail en contient vraiment trop pour faire copier coller.

##################

Merci bien d'avance pour votre coup de main.

Bonjour,

à tester,

Sub test_Liste()
Dim liste()
With Sheets("Feuil1")
  For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
   For c = 2 To .Cells(1, Columns.Count).End(xlToLeft).Column
     n = n + 1
     ReDim Preserve liste(n)
     liste(n) = .Cells(i, 1) & "~" & .Cells(1, c)
   Next c
  Next i
End With
With Sheets("Feuil2")
.[A1].Resize(UBound(liste)) = Application.Transpose(liste)
.Range("A2:A" & .Cells(Rows.Count, 1).End(xlUp).Row).TextToColumns Destination:=Range("A2"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="~", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
End With
End Sub

Bonjour, bonjour Isabelle,

version sans macro juste pour le fun !

Bonjour,

Un nouvel exemple avec VBA.

Cdlt.

Public Sub Create_table()
Dim tbl, arr(), i As Long, j As Long, k As Long
    With Worksheets("Feuil1")
        tbl = .Cells(1).CurrentRegion.Value
        For i = 2 To UBound(tbl)
            For j = 2 To UBound(tbl, 2)
                ReDim Preserve arr(2, k + 1)
                arr(0, k) = tbl(i, 1)
                arr(1, k) = tbl(1, j)
                k = k + 1
            Next j
        Next i
    End With
    With Worksheets("Feuil2")
        .Cells(2, 1).Resize(k, 2) = Application.Transpose(arr)
    End With
End Sub

Bien le bonsoir à tous,

Je sors d'une rencontre avec l'équipe de l'implantation du nouveau système de paye et dans mon coin de pays, nous sommes dimanche soir 8h20.

Demain matin je jette un œil à vos magnifiques réponses et vous reviens avec plein de wow, de hiiii et de chabalawouda.

Bonne nuit à tous, ma petite de 8 ans est en train de s'occuper du BBQ...... à peine

Bonjour spage, le forum,

je te retourne ton fichier modifié :

regarde bien toutes les données (dont la ligne 6 ajoutée)

Ctrl e ➯ travail effectué !

Alt F11 pour voir le code VBA, puis revenir sur Excel

si besoin, tu peux demander une adaptation.

merci de me dire si ça te convient.

dhany

Bonjour,

La proposition initiale révisée sur base du fichier de dhany.

Ctrl + m pour exécuter la procédure.

Cdlt.

Public Sub Create_table()
'Ctrl + m pour exécuter la procédure
Dim tbl, arr(), i As Long, j As Long, k As Long
    With Worksheets("Feuil1")
        tbl = .Cells(1).CurrentRegion.Value
        .Cells(1).CurrentRegion.ClearContents
        For i = 2 To UBound(tbl)
            For j = 2 To UBound(tbl, 2)
                'If tbl(i, j) <> "" Then
                    ReDim Preserve arr(2, k + 1)
                    arr(0, k) = tbl(i, 1)
                    arr(1, k) = tbl(i, j)
                    k = k + 1
                'End If
            Next j
        Next i
        .Cells(1).Resize(k, 2) = Application.Transpose(arr)
    End With
End Sub

oups, erreur de frappe,

remplacer

arr(1, k) = tbl(i, j)

par

arr(1, k) = tbl(1, j)

Steelson a écrit :

Bonjour, bonjour Isabelle,

version sans macro juste pour le fun !

BOnjour,

Mille mercis,

Je ne sais pas qui est Isabelle, mais un grand merci. Ce sont des formules qui fonctionnent à merveille.

De plus ça m'a permit d'acquérir une connaissance de plus en la fonction MOD(). que j'ai dû bien décortiquer et schématiser afin de comprendre son fonctionnement.

Bonne journée.

Je refais des tests en soirée avec les macros.

Re spage,

tu a écrit :

Je ne sais pas qui est Isabelle, mais un grand merci.

Isabelle est sabV (lis sa signature en bas d'un de ses posts).

as-tu essayé le ficher de mon post de 03:20 ?

voici le lien : https://forum.excel-pratique.com/viewtopic.php?p=707718#p707718

qu'en penses-tu ? est-ce que ça te convient ?

dhany

Bien le bonjour,

Merci Beaucoup. Test très concluant,

Je vais m'amuser pour certains des fichiers à traiter.

Ça déborde de solutions.

sabV a écrit :

Bonjour,

à tester,

Sub test_Liste()
Dim liste()
With Sheets("Feuil1")
  For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
   For c = 2 To .Cells(1, Columns.Count).End(xlToLeft).Column
     n = n + 1
     ReDim Preserve liste(n)
     liste(n) = .Cells(i, 1) & "~" & .Cells(1, c)
   Next c
  Next i
End With
With Sheets("Feuil2")
.[A1].Resize(UBound(liste)) = Application.Transpose(liste)
.Range("A2:A" & .Cells(Rows.Count, 1).End(xlUp).Row).TextToColumns Destination:=Range("A2"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="~", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
End With
End Sub

D'accord,

J'ai le choix des trucs qui fonctionne.

Je vais quand même prendre le temps d'analyser pour tester ma compréhension.

Encore Merci pour la rapidité dont tous le monde fait preuve.

Jean-Eric a écrit :

Bonjour,

Un nouvel exemple avec VBA.

Cdlt.

Public Sub Create_table()
Dim tbl, arr(), i As Long, j As Long, k As Long
    With Worksheets("Feuil1")
        tbl = .Cells(1).CurrentRegion.Value
        For i = 2 To UBound(tbl)
            For j = 2 To UBound(tbl, 2)
                ReDim Preserve arr(2, k + 1)
                arr(0, k) = tbl(i, 1)
                arr(1, k) = tbl(1, j)
                k = k + 1
            Next j
        Next i
    End With
    With Worksheets("Feuil2")
        .Cells(2, 1).Resize(k, 2) = Application.Transpose(arr)
    End With
End Sub

Bonjour Dhany

Merci bien pour la macro et le cue.

Je vais devoir aller suivre un cours ou prendre 6 mois de congés pour apprendre le VBA de façon plus sérieuse

..... 6 mois de congé, c'est une bonne idée anyway.

..... pêche et VBA, ce sera un bô programme.

dhany a écrit :

Re spage,

tu a écrit :

Je ne sais pas qui est Isabelle, mais un grand merci.

Isabelle est sabV (lis sa signature en bas d'un de ses posts).

---

as-tu essayé le ficher de mon post de 03:20 ?

voici le lien : https://forum.excel-pratique.com/viewtopic.php?p=707718#p707718

qu'en penses-tu ? est-ce que ça te convient ?

dhany

Bonjour spage,

merci pour ton retour ! je te souhaite bonne pêche !

y'en a déjà un qui t'attend ici :

et tu pourras même faire de la plongée sous-marine :

le VBA, ce sera après être remonté à la surface !

dhany