Convertir un Tableau selon un format donné

[excelnoob]

Bonjour à tous,


Je souhaite convertir un tableau de plusieurs milliers de lignes selon un format bien définit.

J'ai un fichier à un état brut que je souhaite transformer direct en macro, Car avec le temps, le nombre de lignes et les données à l'intérieur vont évoluer.

Etant... nul en macro, je fais appel à vous, pour m'aider dans ce besoin urgent.

Pour vous permettre de comprendre exactement mon besoin, je vous mets un fichier excel.

Le 1er exemple : permet de voir mon format souhaité

En orange, la ligne qui ne bougera pas mais en revanche quelques colonnes vont se décaler pour permettre aux lignes en bleu de s'insérer (la colonne A est représentative de l'obtenu final en binaire 0 ou 1)


Le 2 ème exemple : même résultat souhaité mais sur plusieurs colonnes successives. (l'idée étant d'avoir au final ce résultat sur des milliers de lignes)

J'ai mis des couleurs pour vous montrer les mouvements recherchés (la colonne, A pouvant certainement aider dans l'opération avec le répérage binaire).


Merci d'avance pour votre aide !!

 

[Robert]

Re : [Urgent] _ Convertir un Tableau selon un format donné

Bonsoir Excelnoob et bienvenu, bonsoir le forum,

Peut-être comme ça :

Sub Macro1()
Dim os As Object 'déclare la variable os (Onglet Source)
Dim od As Object 'déclare la variable os d(Onglet Destination)
Dim dl As Long 'déclare la variable dl (Dernière Ligne)
Dim pl As Range 'déclare la variable pl (PLage)
Dim li As Long 'déclare la variable li (LIgne)
Dim dest As Range 'déclare la variable dest (cellule de DESTination)
Dim ld As Long 'déclare la variable ld (Ligne du Début)
Dim r As Range 'déclare la variable r (Recherche)
Dim lf As Long 'déclare la variable lf (Ligne de Fin)

Set os = Sheets("Source") 'définit l'onglet source os (à adapter à ton cas)
Set od = Sheets("Destination") 'définit l'onglet destination od (à adapter à ton cas)
od.Range("A1").CurrentRegion.Clear 'efface les éventuelles anciennes données
dl = os.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée dl de la colonne 1 (=A) de l'onglet source
Set pl = os.Range("A1:A" & dl) 'définit la plage pl
For li = 1 To dl 'boucle sur toutes les lignes de 1 à dl
    'condition 1 : si la cellule en colonne A de la ligne li est égale à 0 et si elle est non vide
    If os.Cells(li, 1).Value = 0 And os.Cells(li, 1).Value <> "" Then
        'définit la cellule de destination dest (A1 si G1 est vide, sinon la première ligne où G est vide)
        Set dest = IIf(od.Range("G1").Value = "", od.Range("A1"), od.Cells(Application.Rows.Count, 7).End(xlUp).Offset(1, -6))
        os.Cells(li, 1).Resize(1, 6).Copy dest 'copie les 6 premières cellules de la ligne li et les colle dans dest
        os.Cells(li, 13).Resize(1, 6).Copy dest.Offset(0, 18) 'copie les autres cellules de la ligne li et les colle en colonne S
        ld = li + 1 'définit la ligne de début ld
        Set r = pl.Find(0, os.Cells(li, 1), xlValues, xlWhole) 'définit la recherche r
        If Not r Is Nothing Then 'condition 2 : si il existe au moins une occurrence trouvée dans la plage pl
            lf = IIf(r.Row > li, r.Row - 1, dl) 'définit la ligne de fin lf
            os.Range(os.Cells(ld, 1), os.Cells(lf, 12)).Copy dest.Offset(0, 6) 'copie la plage et la colle entre les colonnes éditées
        End If 'fin de la condition 2
        li = lf 'redéfinit la ligne li
    End If 'fin de la condition 1
Next li 'prochaine ligne li de la boucle
End Sub

Le fichier :

 

[excelnoob]

Re : [Urgent] _ Convertir un Tableau selon un format donné

Bonjour Robert,


Merci pour ce retour très rapide, j'apprécie énormément, vraiment sympa.

J'ai testé plusieurs fois et je me retrourne vers toi pour 2 petits commentaires :

- J'ai remarqué que si une ligne qui a en colonne A la valeur 0, et serait suivi d'une autre ligne, avec à nouveau en colonne A une valeur 0 , alors on avait une donnée fausse.
Regarde le fichier "Excelnoob_v01(1).xls" , j'ai dans l'onglet "source", modifié entre la ligne 5 et 6. Tu pourras voir le résultat dans l'onglet "Destination" en rouge ce qui ne fonctionne pas .

- Avec un peu de réflexion, je souhaiterais savoir si en repartant du même fichier de base, on peut aussi juste sélectionner certaines cellules en colonne C et L pour les mettre les unes derrière les autres, juste après les ligne orange (en se servant peut-être du critère de la colonne A les 0 et 1)
Voir le fichier "Excelnoob_v01(2).xls". Exemple les ressources de la ligne 6 à 8 mises en couleurs passent en ligne 22, tout à la fin et dans l'ordre.
J'ai mis des couleurs pour aider à la compréhension de mon problème.

Merci encore d'avance pour votre aide très préciseuse.

 

[Compte Supprimé 979]

Re : [Urgent] _ Convertir un Tableau selon un format donné

Bonjour

Merci d'éditer ton premier post et d'enlever la mention [URGENT] 😡

 

[excelnoob]

Re : [Urgent] _ Convertir un Tableau selon un format donné

modifié desolé

 

[Robert]

Re : Convertir un Tableau selon un format donné

Bonjour Excelnoob, bonjour le forum,

Le code modifié :

Sub Macro1()
Dim os As Object 'déclare la variable os (Onglet Source)
Dim od As Object 'déclare la variable os d(Onglet Destination)
Dim dl As Long 'déclare la variable dl (Dernière Ligne)
Dim pl As Range 'déclare la variable pl (PLage)
Dim li As Long 'déclare la variable li (LIgne)
Dim dest As Range 'déclare la variable dest (cellule de DESTination)
Dim ld As Long 'déclare la variable ld (Ligne du Début)
Dim r As Range 'déclare la variable r (Recherche)
Dim lf As Long 'déclare la variable lf (Ligne de Fin)
Dim x As Byte 'déclare la variable x (incrément)
Dim y As Byte 'déclare la variable y (incrément)


Set os = Sheets("Source") 'définit l'onglet source os (à adapter à ton cas)
Set od = Sheets("Destination") 'définit l'onglet destination od (à adapter à ton cas)
od.Range("A1").CurrentRegion.Clear 'efface les éventuelles anciennes données
dl = os.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée dl de la colonne 1 (=A) de l'onglet source
Set pl = os.Range("A1:A" & dl) 'définit la plage pl
For li = 1 To dl 'boucle 1 : sur toutes les lignes de 1 à dl
    'condition 1 : si la cellule en colonne A de la ligne li est égale à 0 et si elle est non vide
    If os.Cells(li, 1).Value = 0 And os.Cells(li, 1).Value <> "" Then
        'définit la cellule de destination dest (A1 si G1 est vide, sinon la première ligne où G est vide)
        Set dest = IIf(od.Range("A1").Value = "", od.Range("A1"), od.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0))
        os.Cells(li, 1).Resize(1, 18).Copy dest 'copie les 18 premières cellules de la ligne li et les colle dans dest
        If os.Cells(li + 1, 1).Value = 0 Then GoTo suite 'la ligne en dessous est égale à 0, va à l'étiquette "suite"
        ld = li + 1 'définit la ligne de début ld
        Set r = pl.Find(0, os.Cells(li, 1), xlValues, xlWhole) 'définit la recherche r
        If Not r Is Nothing Then 'condition 2 : si il existe au moins un occurrence dans la plage pl
            lf = IIf(r.Row > li, r.Row - 1, dl) 'définit la ligne de fin lf
            y = 0 'réinitialise la variable y
            For x = 1 To (lf - ld) + 1 'boucle 2 : sur les ressources
                os.Cells(li + x, 3).Copy dest.Offset(0, 18 + y) 'place le contenu de la colonne C en fin de ligne
                os.Cells(li + x, 12).Copy dest.Offset(0, 18 + y + 1) 'place le contenu de la colonne L en fin de ligne
                y = y + 2 'incrémente y
            Next x 'prochaine ressource de la boucle 2
        End If 'fin de la condition 2
        li = lf 'redéfinit la ligne li
    End If 'fin de la condition 1
suite: 'étiquette
Next li 'prochaine ligne li de la boucle
End Sub

Le fichier :

[Édition]
Oui Bruno a raison, il n'est pas recommandé de mettre URGENTet autres HELP ou OS COURT dans les intitulés. Comme tu es tout nouveau parmi nous je te recommande de lire la Lien supprimé qui te donnera tous les bons plans pour obtenir de l'aide rapidement. J'ai adoré le ton de sa demande. Il a dû être au moins caporal chef lui. Enfin je connais pas trop les grades, j'ai pas fait l'armée moi...

 

[excelnoob]

Re : Convertir un Tableau selon un format donné

Bonjour Robert,

J'ai testé ton code modifié sur un fichier conséquent.

Il fonctionne parfaitement.

Je te remercie beaucoup pour ton aide apportée.

Encore Merci beaucoup !!


Et pas de soucis pour le rappel à l'ordre c'est normal 😉

A bientôt $