Développez des lignes à partir des colonnes.

Version imprimable

09/11/2017, 14h15
Myaccess

1 pièce(s) jointe(s)

Développez des lignes à partir des colonnes.

Bonjour a tous,

Voila, je cherche une macro qui me permet de développer des lignes à partir des colonnes.

Un un exemple très claire est en pièce jointe.

Merci d'avance.Pièce jointe 325924
09/11/2017, 14h24
unparia

Bonjour

Citation:

Un un exemple très claire est en pièce jointe.

Peut-être.
Mais :
https://www.developpez.net/forums/d8...s-discussions/
et lire ce qu'en dit ma signature

Tu es quand-même ici depuis plusieurs mois ...
Je sors donc (je n'aurais jamais du entrer dans cette discussion).
09/11/2017, 15h00
Myaccess

En réalité, je n'étais pas au courant de ça mais pas exactement dans ce contexte.
De mes habitudes, j'utilise la pièce jointe pour donner un aperçu rapide de mon problème afin que mon interlocuteur puisse comprendre rapidement, et ce n'est pas pour trouver une solution direct sur la pièce jointe (fichier), ce sont deux choses différentes, c'est une question de temps à gagner en quelque sorte, je pense que cela intéresse les deux cotés (le destinataire et l'interlocuteur).
09/11/2017, 15h19
Menhir

Ouvrir une pièce jointe, c'est prendre un risque que beaucoup de participants à ce forum refusent.

Surtout que tu proposes un fichier Word pour un problème Excel, ce qui veut dire que ta pièce jointe ne contient, au mieux, que du texte et des images que tu aurais pu mettre dans ton message.
09/11/2017, 15h24
Myaccess

La, je suis bien d'accord.
Merci bien.
09/11/2017, 16h33
unparia

Et l'image elle-même ne permet pas de déterminer AVEC CERTITUDE si ce qui apparait en colonnes "Poste" et "Testfinal" est constiotué :
- de plusieurs lignes Excel non fusionnées et sans bordures interieures
ou
- d'une seule cellule Excel fusionnée
etc ...
Plus maladroit, tu meurs ...
Il était tellement plus simple :
- soit d'exposer techniquement (si si : c'est possible et très facilement ...)
- soit de montrer une copie d'écran de la feuille Excel
Conclusions :
1) j'attends de savoir de dont il s'agit avec précision
2) voilà plusieurs sujets qui, ces temps-ci, ont pour finalité de "rattraper" des maladresses initiales de modélisation des données ... :pleure: C'est à la mode ?
12/11/2017, 14h37
Myaccess

1 pièce(s) jointe(s)

Ok unparia,
Je vais essayer de mieux exprimer mon probléme...
Dans mon cas, j'aimerai convertir le contenu des colonnes de chaque individu vers des lignes.
Voici donc un autre extrait comme exemple sur excel.
Pièce jointe 326648
12/11/2017, 16h37
unparia

Il me semble avoir déjà traité un problème tout-à-fait similaire il n'y a pas si longtemps.
Tu fais une recherche ou je recommence (encore et encore) ? ;)

Bon...
J'ai horreur de faire deux fois exactement la même chose.
J'en ai donc écrit un autre, sur la base de tes indications et de l'image affichée dans ton premier message --->>
Code:

1 2 3 4 5 6 7 8 9 10 11 Dim derlig As Long, i As Long, k As Byte, quoi derlig = Range("A" & Rows.Count).End(xlUp).Row For i = derlig + 1 To 3 Step -1 quoi = WorksheetFunction.Transpose(Range(Cells(i - 1, 3), Cells(i - 1, 5))) For k = 1 To 2 Rows(i).Insert Cells(i, 1).Value = Cells(i, 1).Value Next Range(Cells(i - 1, 3), Cells(i + 1, 3)).Value = quoi Next Range("D:E").ClearContents
Dis bonjour à l'arithmétique (en espérant que tu ne la détestes pas). C'est elle, qui règne dans ce code-là. ;)

13/11/2017, 09h31
Myaccess

1 pièce(s) jointe(s)

J'aime bien...

Citation:

Envoyé par unparia

J'ai horreur de faire deux fois exactement la même chose.

Mais on dit, jamais 2 sans 3...!

Merci Unparia pour cette première tentative,
Bon, le code a bien fait certains changement mais pas aussi juste.
Je préfère vous montrer un autre extrait du résultat obtenu par ce code.Pièce jointe 326811

Bonjour,

Voici une autre solution :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Option Explicit
Dim dl dc pcr ws k i j As Variant
Sub aargh()
    With Sheets("sheet1") 'feuille source
       dl = .Cells(Rows.Count, 1).End(xlUp).Row
        dc = .Cells(1, Columns.Count).End(xlToLeft).Column
        pcr = 4
        Sheets.Add after:=Sheets(Sheets.Count)
        Set ws = ActiveSheet 'feuille destination
       .Cells(1, 1).Resize(, pcr).Copy ws.Range("A1")
        k = 1
        For i = 2 To dl
            For j = pcr To dc
                If .Cells(i, j) <> "" Then
                    k = k + 1
                    .Cells(i, 1).Resize(, pcr).Copy ws.Cells(k, 1)
                    ws.Cells(k, pcr) = .Cells(i, j)
                End If
            Next j
        Next i
    End With
End Sub