Déconcatener lignes en colonnes

Bonjour tout le monde,

J'aimerais réaliser une macro qui permet en l'occurence de déconcatener une ligne en plusieurs colonnes par rapport à un code d'article.

En fouillant un peu le forum, j'ai réussi à tomber sur un cas similaire mais il y a quand même un petit problème : il y a une bonne partie quand même que la macro ne prend pas en charge. Pouvez-vous m'aider s'il vous plaît.

Merci d'avance

11export-praxedo-1.zip (279.04 Ko)

Bonsoir

je viens de consulter le fichier...

1 seul onglet.. et déjà beaucoup de colonne... alors que la demande est :

J'aimerais réaliser une macro qui permet en l'occurence de déconcatener une ligne en plusieurs colonnes par rapport à un code d'article

Donc je ne comprend pas... alors....que faut-il faire ?? que faut-il modifier ???

Fred

Bonjour,

Si par déconcatener une ligne, vous entendez une chaine de caractères à séparateur fixe, alors il faudrait faire quelque chose comme ça :

Option base 1

Sub Deconcatener()

Dim Tab() as string

Tab = split(Range("A1").value, séparateur) 'si chaine à diviser en A1

Range("A1").offset(0, 1).resize(1, Ubound(Tab)).value = Tab

end sub

Il faut toutefois indiquer la cellule visée et le séparateur.

Cordialement,

Bonjour,

J'ai pas été assez précis : dans la colonne AI se trouve le code article séparer par un même séparateur fixe " | ": ce que je voudrais c'est que chaque article a sa propre ligne dans tout le tableau, c'est-à-dire qu'il n'y a plus de séparateur du tout.

3GB > oui, c'est ça que je voulais dire. Je vais essayer d'adapter ton bout de code et revenir vers vous.

Bonjour...

c'est peut-être en colonne AN et non pas AI.... => colonne Liste des articles

bon maintenant on sait qu'elle colonne il faut traiter... ok... on ne colle que la liste sur des nouvelles lignes ? ou il faut reprendre toutes les données de la ligne ?

Fred

Oui, c'est ça, colonne AN, désolé je viens de re visualiser le fichier, c'est exact.

Oui, je voudrais reprendre toute la donnée de la ligne en question et en gros faire insertion, même ligne puis au niveau de "Liste des articles" qu'il y ait seulement un article : par exemple dans liste des articles j'ai "1.0 CLASM | 1.0 PVQPA" je voudrais qu'il y a deux lignes pareilles sauf que en liste des articles j'ai ligne 23 1.0 CLASM et ligne 24 1.0 PVQPA

Bonjour,

J'ai crois que j'ai mieux saisi votre besoin, sans pour autant m'attarder sur les détails qui pourraient poser problème.

En tout cas, mon précédent code ne correspond pas à votre attente. En voici un nouveau (que je n'ai pas testé) qui pourrait aller, à condition qu'il fonctionne correctement

Option base 1

Sub Deconcatener()

Dim MonTableau as Range, Cell as range, NvCell as range
Dim Tab() as string
Dim AddressCell$

Set MonTableau = Range("I1:AQ1410") 'Tableau entier des articles

for each Cell in MonTableau.columns(32) 'Pour chaque cellule de la colonne 32 de MonTableau (la 32e)
    If not Cell.value = "" Then 'Si la valeur de la cellule est non vide
        On error goto Reprise 'Passer à la cellule suivante si erreur liée au Split
        AddressCell = Cell.Address  'On stocke l'adresse de Cell
        Tab = split(Cell.value, "|") 'Tableau temporaire contenant les sous-articles séparés par une barre verticale
        set NvCell = Cell 'Nouvelle cellule temporaire : vaut notre cellule active pour l'instant

        For i = 1 to Ubound(Tab)-1  'Itération des opérations suivantes autant de fois qu'il n'y a des sous-articles à insérer
            MonTableau.rows(NvCell.row).copy 'Copie la ligne active
            MonTableau.rows(NvCell.row).insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 'insérer les donnée sur une nouvelle ligne
            Set NvCell = NvCell.offset(1, 0) 'NvCell devient la Cell suivante
        Next i

        Cell.resize(Ubound(Tab), 1).value = Tab 'Notre Tab temporaire colle les valeurs sur les cellules Cell à Dernière NvCell

        Set NvCell = Nothing 'Libération de NvCell
        Set Cell = Range(AddressCell) 'Cell redevient Cell au cas où
        Set MonTableau = MonTableau.resize(MonTableau.rows.count + Ubound(Tab)-1, MonTableau.columns.count) 'redimensionne MonTableau avec nvlles lignes
Reprise:
    end if
next Cell 'Nouvelle cellule

Set MonTableau = Nothing

end sub

Je ne suis pas sûr du résultat que ça donnera car il y a une boucle sur une colonne qui agrandit au fur et à mesure de l'exécution de la boucle. Le risque d'erreur n'est donc pas nul.

Cordialement,

Salut, merci bien pour la réponse, je vais essayer ça et revenir vers toi mais y a un soucis dès la déclaration du tableau, est-ce normal ?

Non, normalement, ce n'est pas normal...

En fait, je saisis d'un trait sans tester et je fais des modifications en cours donc j'oublie de rectifier le type des variables ou autres.

J'ai édité mon commentaire, ça devrait être mieux maintenant

Hmm d'accord je comprends mieux, autant pour moi ^^'

Euh là ça me met tjrs la même erreur au niveau de la déclaration de la variable Tab() -> erreur d'identificateur

Option base 1

Sub Deconcatener()

Dim MonTableau as Range, Cell as range, NvCell as range
Dim Tampon()
Dim AddressCell$

Set MonTableau = Range("I1:AQ1410") 'Tableau entier des articles

for each Cell in MonTableau.columns(32) 'Pour chaque cellule de la colonne 32 de MonTableau (la 32e)
    If not Cell.value = "" Then 'Si la valeur de la cellule est non vide
        On error goto Reprise 'Passer à la cellule suivante si erreur liée au Split
        AddressCell = Cell.Address  'On stocke l'adresse de Cell
        Tampon = split(Cell.value, "|") 'Tableau temporaire contenant les sous-articles séparés par une barre verticale
        set NvCell = Cell 'Nouvelle cellule temporaire : vaut notre cellule active pour l'instant

        For i = 1 to Ubound(Tampon)-1  'Itération des opérations suivantes autant de fois qu'il n'y a des sous-articles à insérer
            MonTableau.rows(NvCell.row).copy 'Copie la ligne active
            MonTableau.rows(NvCell.row).insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 'insérer les donnée sur une nouvelle ligne
            Set NvCell = NvCell.offset(1, 0) 'NvCell devient la Cell suivante
        Next i

        Cell.resize(Ubound(Tampon), 1).value = Tampon 'Notre Tab temporaire colle les valeurs sur les cellules Cell à Dernière NvCell

        Set NvCell = Nothing 'Libération de NvCell
        Set Cell = Range(AddressCell) 'Cell redevient Cell au cas où
        Set MonTableau = MonTableau.resize(MonTableau.rows.count + Ubound(Tampon)-1, MonTableau.columns.count) 'redimensionne MonTableau avec nvlles lignes
Reprise:
    end if
next Cell 'Nouvelle cellule

Set MonTableau = Nothing

end sub

Salut,

J'ai une erreur au niveau de la condition "If Not" ; j'aimerais savoir aussi lorsque je règle mon tableau contenant les articles, y a pas moyen d'utiliser une fonction tq Rows.Count pour qu'il s'adapte selon le dernier code article ?

La fonction Ubound(tableau) est uniquement applicable à un tableau pour dire que c'est la dernière valeur ?
La fonction resize sert juste à délimiter de part et d'autres notre tableau comme lorsque l'on double clique sur les lignes pour que ça s'adapte ?
La fonction Split avec ses arguments elle permet de couper la ligne en question dès qu'elle repère le séparateur c'est ça ?

Merci d'avance ^^'

Salut,

Alors, quelle est l'erreur au niveau du If not ? Si tu as une erreur que tu n'arrives pas à résoudre, il serait préférable que tu fasses une impression du module.

Est-ce que par hasard tu as modifié la ligne :

Set MonTableau = Range("I1:AQ1410")

Parce qu'ensuite, on boucle sur la 32è colonne de MonTableau...

Ubound renvoie la dimension d'une variable tableau.

Resize redimensionne une plage. Ici, on insère des lignes donc il faut redéfinir ton tableau en tenant compte de ses nouvelles dimensions.

Split divise une chaine de caractères en fonction d'un séparateur en plusieurs chaines distinctes, contenues dans une variable tableau.

Cordialement,

Re,

Déjà oui j'avais modifié les dimensions de mon tableau, autant pour moi vu que j'avais caché quelques informations j'ai fais en sorte de reprendre depuis A1 mais bon là en l'occurence je viens de remettre I1. Pareil pour le colomne 32, vu que AN correspondait à la colonne 40 je pensais que y avait une erreur mais vu que l'on commence à la colonne I autant pour moi ^^'

Du coup, la fonction Split exécuté sa fonction dans un tableau en parallèle c'est bien ça ?

Split renvoie une ensemble de valeurs (sous chaines) qui sont à stocker dans un tableau.

Ici, split est utilisé en cours de programme, sur chaque cellule non-vide de la colonne 32 du tableau. Seule, split ne renverrait rien alors, en cas de cellule non-vide contenant le séparateur stipulé (donc en cas de déconténation), on insère des lignes (dimension de split -1) et on colle les sous-chaines.

Le -1 correspond à l'effacement du séparateur, c'est bien ça ?

Le programme me dis toujours la même erreur, à savoir incompatibilité de type au niveau de la condition : voici le code que j'ai actuellement ma macro.

Option Base 1
Sub Deconcatener()

Dim MonTableau As Range, Cell As Range, NvCell As Range
Dim Tampon()
Dim AddressCell$

Set MonTableau = Range("I1:AQ1410") 'Tableau entier des articles

For Each Cell In MonTableau.Columns(32) 'Pour chaque cellule de la colonne 32 de MonTableau (la 32e)
    If Not Cell.Value = "" Then 'Si la valeur de la cellule est non vide
        On Error GoTo Reprise 'Passer à la cellule suivante si erreur liée au Split
        AddressCell = Cell.Address  'On stocke l'adresse de Cell
        Tampon = Split(Cell.Value, "|") 'Tableau temporaire contenant les sous-articles séparés par une barre verticale
        Set NvCell = Cell 'Nouvelle cellule temporaire : vaut notre cellule active pour l'instant

        For i = 1 To UBound(Tampon) - 1 'Itération des opérations suivantes autant de fois qu'il n'y a des sous-articles à insérer
            MonTableau.Rows(NvCell.Row).Copy 'Copie la ligne active
            MonTableau.Rows(NvCell.Row).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 'insérer les donnée sur une nouvelle ligne
            Set NvCell = NvCell.offset(1, 0) 'NvCell devient la Cell suivante
        Next i

        Cell.resize(UBound(Tampon), 1).Value = Tampon 'Notre Tab temporaire colle les valeurs sur les cellules Cell à Dernière NvCell

        Set NvCell = Nothing 'Libération de NvCell
        Set Cell = Range(AddressCell) 'Cell redevient Cell au cas où
        Set MonTableau = MonTableau.resize(MonTableau.Rows.Count + UBound(Tampon) - 1, MonTableau.Columns.Count) 'redimensionne MonTableau avec nvlles lignes
Reprise:
    End If
Next Cell 'Nouvelle cellule

Set MonTableau = Nothing

End Sub

Pour 3 séparateurs, il y a 4 sous-chaines. Mais on insère 3 lignes supplémentaires car celle en cours est conservée, c'est pour ça.

C'est embêtant ça, je ne comprends pas. C'est le cell qui n'est pas bien reconnu comme une cellule.

Peux-tu essayer comme ça :

Option Base 1
Sub Deconcatener()

Dim MonTableau As Range, Maplage as range, NvCell As Range
Dim Tampon()
Dim AddressCell$

Set MonTableau = Range("I1:AQ1410") 'Tableau entier des articles
Set Maplage = MonTableau.columns(32) 'colonne des codes

For Each Cell In Maplage 'Pour chaque cellule de la colonne 32 de MonTableau (la 32e)
    If Not Cell.Value = "" Then 'Si la valeur de la cellule est non vide
        On Error GoTo Reprise 'Passer à la cellule suivante si erreur liée au Split
        AddressCell = Cell.Address  'On stocke l'adresse de Cell
        Tampon = Split(Cell.Value, "|") 'Tableau temporaire contenant les sous-articles séparés par une barre verticale
        Set NvCell = Cell 'Nouvelle cellule temporaire : vaut notre cellule active pour l'instant

        For i = 1 To UBound(Tampon) - 1 'Itération des opérations suivantes autant de fois qu'il n'y a des sous-articles à insérer
            MonTableau.Rows(NvCell.Row).Copy 'Copie la ligne active
            MonTableau.Rows(NvCell.Row).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 'insérer les donnée sur une nouvelle ligne
            Set NvCell = NvCell.offset(1, 0) 'NvCell devient la Cell suivante
        Next i

        Cell.resize(UBound(Tampon), 1).Value = Tampon 'Notre Tab temporaire colle les valeurs sur les cellules Cell à Dernière NvCell

        Set NvCell = Nothing 'Libération de NvCell
        Set Cell = Range(AddressCell) 'Cell redevient Cell au cas où
        Set MonTableau = MonTableau.resize(MonTableau.Rows.Count + UBound(Tampon) - 1, MonTableau.Columns.Count) 'redimensionne MonTableau avec nvlles lignes
        Set Maplage = MonTableau.columns(32)
Reprise:
    End If
Next Cell 'Nouvelle cellule

Set Maplage = Nothing
Set MonTableau = Nothing

End Sub

Salut,

Pour 3 séparateurs, il y a 4 sous-chaines. Mais on insère 3 lignes supplémentaires car celle en cours est conservée, c'est pour ça.

Ah ouais, effectivement, merci beaucoup pour cette explication!

Sinon, je viens de rester le code et j'ai toujours la même erreur au niveau de la ligne "If Not"

Je vais l'adapter alors, quand j'aurai un petit moment...

A bientôt,

Salut,

Est-ce que tu peux essayer ce code :

Sub Deconcatener()

Dim MonTableau As Range, Maplage As Range, NvCell As Range
Dim Tampon() As String
Dim i%, j%

Set MonTableau = Range("I1:AQ1410") 'Tableau entier des articles (A ADAPTER)
Set Maplage = MonTableau.Columns(32) 'Colonne des codes à déconcaténer - ici, 32è du tableau(A PERSONNALISER)

i = 1
While i < Maplage.Cells.Count + 1  'Parcourt les cellules de ma colonne (tant que cellule en cours n'est pas à la dernière ligne)

    If Maplage.Cells(i).Value <> "" Then 'Si la valeur de la cellule est non vide

        On Error GoTo Reprise 'Passer à la cellule suivante si erreur liée au Split
        Tampon = Split(Maplage.Cells(i).Value, "|") 'Tableau temporaire contenant les sous-articles séparés par une barre verticale

        If UBound(Tampon) > 0 Then 'si Tampon contient plus de 2 valeurs (cad en cas de déconcaténation effectuée)

            Set NvCell = Maplage.Cells(i) 'Nouvelle cellule temporaire : vaut notre cellule active pour l'instant

            For j = 1 To UBound(Tampon) 'Itération des opérations suivantes autant de fois qu'il n'y a des sous-articles à insérer
                MonTableau.Rows(NvCell.Row - 1).Copy 'Copie la ligne active
                MonTableau.Rows(NvCell.Row).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 'insérer les donnée sur une nouvelle ligne
                Set NvCell = NvCell.Offset(1, 0) 'NvCell devient la Cell suivante
            Next j

        Maplage.Cells(i, 1).Resize(UBound(Tampon) + 1, 1).Value = Tampon 'collage des articles sous-chaines sur la cellule en cours + cellules créées
        Set NvCell = Nothing 'Libération de NvCell

        End If

Reprise:
    End If
i = i + 1 'cellule suivante
Wend

Set Maplage = Nothing
Set MonTableau = Nothing

End Sub

De mon côté, tout fonctionne, sauf le report des articles dans la colonne 32. Essaie quand même car je ne rencontre pas ce problème sur windows donc il est probable que tout marche chez toi.

A+,

Rechercher des sujets similaires à "deconcatener lignes colonnes"