Réorganiser des données dans un tableau VBA

Résolu/Fermé
Signaler
-
 mathieu81 -
Bonjour,

J'ai besoin d'écrire une macro VBA qui répond à cette tâche :
je cherche à transformer un tableau de données Excel en un autre tableau Exel dans lequel les données sont réorganisées de la façon suivante :

Remarque : chaque terme (lettre ou chiffre) est dans une cellule "abc", "bfa","dbc", "fab" et "cfa"

Tableau source :
1 a b c
1 b f a
2 d b c
2 f a b
4 c f a

Tableau cible :
1 abc bfa
2 dbc fab
4 cfa

Il s'agit de regrouper les termes de la première colonne du premier tableau afin d'obtenir une seule ligne dans le tableau cible et qu'il y ait autant de colonnes générées que de lignes ayant le même terme en tête dans le tableau source. On passe ainsi de 3 colonnes pour la première ligne a b c à une seule colonne contenant le terme abc dans le tableau cible.

Amicalement,

5 réponses

Messages postés
16537
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
25 novembre 2021
3 249
re,

ci dessous proposition:

Option Explicit
Dim coll As Collection, occur As String
Sub tranposer_colonne()
Dim derlig As Long, col_item As Long
Dim lignes As Long, num As Long, nbre As Long

Sheets(2).Cells.ClearContents
Application.ScreenUpdating = False

With Sheets(1)
   .Activate
    derlig = .Range("A65536").End(3).Row
    Set coll = New Collection
    For col_item = 1 To derlig
        On Error Resume Next
        coll.Add .Cells(col_item, 1).Value, CStr(.Cells(col_item, 1))
        On Error GoTo 0
    Next

    lignes = 1
    For num = 1 To coll.Count
        occur = coll(num)
        nbre = Application.CountIf(.Range("A:A"), occur)
            ecrire nbre, lignes, num
        lignes = lignes + nbre
    Next
End With
Sheets(2).Activate

End Sub

Sub ecrire(cptr As Long, ligne As Long, num_o As Long)
Dim der_col As Byte, col As Byte 'integer si XL2007
Dim grp As Long
Dim cellules As String
Dim tablo
 For grp = 0 To cptr - 1
            der_col = Sheets(1).Cells(ligne + grp, 256).End(xlToLeft).Column
                cellules = cellules & occur & " "
                For col = 2 To der_col
                    cellules = cellules & Cells(ligne + grp, col) & " "
                Next
        Next
         tablo = Split(cellules)
        Sheets(2).Cells(num_o, 1).Resize(1, UBound(tablo)) = tablo
        
End Sub


colonne des identifications (1,2,3...) en colonne A feuil1
restitution en feuil2

ci joint p'tite démo
https://www.cjoint.com/?fiekuJZEwq

et une petite demo
1
Merci

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

CCM 41989 internautes nous ont dit merci ce mois-ci

Messages postés
16537
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
25 novembre 2021
3 249
Bonjour,

eh ben voilà!

dans la colonne de gauche, les données sont t elle regroupées: c.a.d. tous les 1 ensemble, les 2 ensemble etc.

cela change complètement la macro et la complique s'ils sont séparés, par ex: 1,1,1,2,2,3,1
et si oui, peut-on les regrouper dans la macro (tri ou autre)?

sinon, un problème similaire a été posé hier avec un "fixe" de 4 lignes:
http://www.commentcamarche.net/forum/affich 12302859 macro allignant de 4 lignes sous excel?#8
dans l'attente,
Bonjour,

Tous les termes de la première colonne sont regroupés. Il n'y a pas de complications de ce coté.

Malheureusement le "fixe" ne me permet pas d'avancer. Le problème n'est pas résolu.

Amicalement,
Messages postés
16537
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
25 novembre 2021
3 249
OK, je regarde ça: réponse en fin d'aprem ou demain fin de matinée pour ma part mais peut-être que d'ici là, un autre membre du forum t'aura fourni une proposition valable....
Merci pour ton aide,

ce programme correspond exactement à ma demande.

Il me reste à l'adapter à mon tableau en ajoutant quelques autres fonctionnalités.

Merci

Amicalement,