XL 2019 Conversion de plusieurs valeurs de colonnes en lignes

Dadi147 · 26 Septembre 2022

Bonjour, aidez-moi s'il vous plaît. J'ai un grand nombre de nombres en double dans une colonne et je veux les convertir en lignes comme sur l'image. Y-a-t-il un moyen de faire ça?
Je veux le copier Sheet2

mapomme · 26 Septembre 2022

Bonjour à tous,

Via ce code :

VB:

Sub ParLigne()
Dim der, t, ref, nbr&, i&, i1&, i2&
With ActiveSheet
   If .FilterMode Then .ShowAllData
   der = Cells(Rows.Count, "a").End(xlUp).Row
   Columns("a:e").Resize(der).Sort key1:=Range("a1"), order1:=xlAscending, _
         key2:=Range("b1"), order2:=xlAscending, Header:=xlYes
   t = Columns("a:e").Resize(der + 1).Value2
   ReDim r(1 To 1, 1 To Columns.Count - Range("h1").Column - 1)
   Range(Range("h1"), Cells(Rows.Count, Columns.Count)).Clear
   ref = t(2, 1): i1 = 2: i2 = i1: nbr = 1: r(1, nbr) = ref
   Do
      If t(i2, 1) = ref Then
         nbr = nbr + 1: r(1, nbr) = t(i2, 3)
         nbr = nbr + 1: r(1, nbr) = t(i2, 4)
         nbr = nbr + 1: r(1, nbr) = t(i2, 5)
         i2 = i2 + 1...

xUpsilon · 26 Septembre 2022

Bonjour,

Via un Tableau Croisé Dynamique ?

Bonne journée,

Dadi147 · 26 Septembre 2022

xUpsilon à dit:
Bonjour,

Via un Tableau Croisé Dynamique ?

Bonne journée,

Bonjour, il n'y a pas de table de feuille Excel régulière, je veux juste créer un code vba qui peut extraire ou transférer les valeurs des colonnes C, D, E en lignes comme sur l'image

xUpsilon · 26 Septembre 2022

Bonjour,

Quelque chose comme ça ?

Bonne journée,

mapomme · 26 Septembre 2022

Bonjour à tous,

Via ce code :

VB:

Sub ParLigne()
Dim der, t, ref, nbr&, i&, i1&, i2&
With ActiveSheet
   If .FilterMode Then .ShowAllData
   der = Cells(Rows.Count, "a").End(xlUp).Row
   Columns("a:e").Resize(der).Sort key1:=Range("a1"), order1:=xlAscending, _
         key2:=Range("b1"), order2:=xlAscending, Header:=xlYes
   t = Columns("a:e").Resize(der + 1).Value2
   ReDim r(1 To 1, 1 To Columns.Count - Range("h1").Column - 1)
   Range(Range("h1"), Cells(Rows.Count, Columns.Count)).Clear
   ref = t(2, 1): i1 = 2: i2 = i1: nbr = 1: r(1, nbr) = ref
   Do
      If t(i2, 1) = ref Then
         nbr = nbr + 1: r(1, nbr) = t(i2, 3)
         nbr = nbr + 1: r(1, nbr) = t(i2, 4)
         nbr = nbr + 1: r(1, nbr) = t(i2, 5)
         i2 = i2 + 1
      Else
         Cells(Rows.Count, "h").End(xlUp).Offset(1).Resize(, nbr) = r
         ReDim r(1 To 1, 1 To Columns.Count - Range("h1").Column - 1)
         i1 = i2: i2 = i1: ref = t(i2, 1): nbr = 1: r(1, nbr) = ref
         If ref = "" Then Exit Do
      End If
   Loop
End With

Dadi147 · 26 Septembre 2022

xUpsilon à dit:
Bonjour,

Quelque chose comme ça ?

Bonne journée,

Merci de votre intérêt pour le sujet... J'ai essayé, ça répond vraiment aux exigences, mais c'est lent.. Malheureusement, merci encore

Dadi147 · 26 Septembre 2022

mapomme à dit:

Bonjour à tous,

Via ce code :

VB:

Sub ParLigne()
Dim der, t, ref, nbr&, i&, i1&, i2&
With ActiveSheet
   If .FilterMode Then .ShowAllData
   der = Cells(Rows.Count, "a").End(xlUp).Row
   Columns("a:e").Resize(der).Sort key1:=Range("a1"), order1:=xlAscending, _
         key2:=Range("b1"), order2:=xlAscending, Header:=xlYes
   t = Columns("a:e").Resize(der + 1).Value2
   ReDim r(1 To 1, 1 To Columns.Count - Range("h1").Column - 1)
   Range(Range("h1"), Cells(Rows.Count, Columns.Count)).Clear
   ref = t(2, 1): i1 = 2: i2 = i1: nbr = 1: r(1, nbr) = ref
   Do
      If t(i2, 1) = ref Then
         nbr = nbr + 1: r(1, nbr) = t(i2, 3)
         nbr = nbr + 1: r(1, nbr) = t(i2, 4)
         nbr = nbr + 1: r(1, nbr) = t(i2, 5)
         i2 = i2 + 1
      Else
         Cells(Rows.Count, "h").End(xlUp).Offset(1).Resize(, nbr) = r
         ReDim r(1 To 1, 1 To Columns.Count - Range("h1").Column - 1)
         i1 = i2: i2 = i1: ref = t(i2, 1): nbr = 1: r(1, nbr) = ref
         If ref = "" Then Exit Do
      End If
   Loop
End With

Bonjour, vous êtes vraiment super, merci beaucoup .. il y a une dernière question, si vous me le permettez, est-il possible de copier les en-têtes de colonne dans l'ordre
Même si tu n'es pas un génie

mapomme · 26 Septembre 2022

Re,

Dadi147 à dit:
est-il possible de copier les en-têtes de colonne dans l'ordre

Voir fichier joint. Cliquer sur le bouton Hop!

Le code est dans module1:

VB:

Sub ParLigne()
Dim der, t, ref, nbr&, i&, i1&, i2&, max&
With ActiveSheet
   If .FilterMode Then .ShowAllData
   der = .Cells(Rows.Count, "a").End(xlUp).Row
   .Columns("a:e").Resize(der).Sort key1:=.Range("a1"), order1:=xlAscending, _
         key2:=.Range("b1"), order2:=xlAscending, Header:=xlYes
   t = .Columns("a:e").Resize(der + 1).Value2
   ReDim r(1 To 1, 1 To .Columns.Count - .Range("h1").Column - 1)
   .Range(.Range("h1"), .Cells(Rows.Count, .Columns.Count)).Clear
   ref = t(2, 1): i1 = 2: i2 = i1: nbr = 1: r(1, nbr) = ref
   Do
      If t(i2, 1) = ref Then
         nbr = nbr + 1: r(1, nbr) = t(i2, 3)
         nbr = nbr + 1: r(1, nbr) = t(i2, 4)
         nbr = nbr + 1: r(1, nbr) = t(i2, 5)
         i2 = i2 + 1
      Else
         If nbr > max Then max = nbr
         .Cells(Rows.Count, "h").End(xlUp).Offset(1).Resize(, nbr) = r
         ReDim r(1 To 1, 1 To .Columns.Count - .Range("h1").Column - 1)
         i1 = i2: i2 = i1: ref = t(i2, 1): nbr = 1: r(1, nbr) = ref
         If ref = "" Then Exit Do
      End If
   Loop
   .Cells(1, "a").Copy .Cells(1, "h")
   .Cells(1, 3).Resize(, 3).Copy .Cells(1, "i").Resize(, max - 1)
End With
End Sub

XL 2019 Conversion de plusieurs valeurs de colonnes en lignes

Dadi147

XLDnaute Occasionnel

mapomme

xUpsilon

XLDnaute Accro

Dadi147

XLDnaute Occasionnel

xUpsilon

XLDnaute Accro

Pièces jointes

mapomme

XLDnaute Barbatruc

Dadi147

XLDnaute Occasionnel

Dadi147

XLDnaute Occasionnel

Pièces jointes

mapomme

XLDnaute Barbatruc

Pièces jointes

Discussions similaires