Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Déconcaténation double et tri parmi

  • Initiateur de la discussion Initiateur de la discussion Membre supprimé 156683
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

M

Membre supprimé 156683

Guest
Bonjour à tous,


Je cherche à déconcaténer 2 colonnes en mm temps de manière à avoir les bonnes informations l’une à coté de l’autre (ceci me servira à des calculs de stats) :

Comme vous pourrez le voir sur l’extrait de mon tableau ci-joint, je cherche à déconcaténer les données des colonnes 21 et 21 (U et V) dans les colonnes nouvellement insérées juste à côté : je veux que les cellules des 2 colonnes références gardent les premières valeurs des données concaténées, puis que soient copiées les données suivantes dans les 2 colonnes d’après, et enfin le reste dans les 2 dernières colonnes.

Je cherche à avoir des données uniques dans les 4 premières colonnes et s’il en existe plus, mettre tout le reste dans les 2 dernières colonnes.

J’ai commencé à utiliser le code d’une autre macro dont j’ai eu besoin pour une déconcaténation en ligne (dans le fichier).

Mais je n’arrive pas à réaliser la boucle, qui me permet de déconcaténer et au-delà de 2 valeurs mettre tout le reste dans la colonne 3.

J’espère avoir été clair 😉

Je vous remercie d’avance pour vos réponses.

M&m
 

Pièces jointes

Re : Déconcaténation double et tri parmi

Bonjour,

Ce n'est pas très clair mais voici une proposition:
Code:
Sub toto()
l1 = 3
c1 = 21
c2 = 22
While Cells(l1, c1) <> ""
    txt1 = Split(Cells(l1, c1), ";")
    txt2 = Split(Cells(l1, c2), ";")
    c3 = 22
    For b = 0 To UBound(txt1)
        c3 = c3 + 1
        Cells(l1, c3) = txt1(b)
        c3 = c3 + 1
        Cells(l1, c3) = txt2(b)
    Next
l1 = l1 + 1
Wend
End Sub
 
Re : Déconcaténation double et tri parmi

Tout d’abord merci à vous d’avoir pris le temps de me répondre,

J’ai testé vos 2 solutions mais je remarque la même erreur (dûe à mes explications sûrement :x) les « colonnes de référence » U et V doivent être modifiées pr ne laisser qu’une seule donnée avec sa date dans ces colonnes (les premières des listes présentes dans les cellules de référence) .

De même dans les 2 colonnes juste à coté de celle-ci (W et X) ne doivent apparaitre qu’une seule donnée avec sa date (les 2èmes des listes dans les cellules de référence).

Et c’est seulement dans les colonnes Y et Z que doit apparaitre le reste s’il y en a un : par exemple dans le cas d’une liste de 4 noms et 4 dates, Y et Z doivent contenir 2 données et 2 dates.

J’espère avoir éclairci les zones d’ombres.

M&m
 
Re : Déconcaténation double et tri parmi

Bonjour,

Voici la macro corrigée :

Code:
Sub toto()
l1 = 3
c1 = 21
c2 = 22
While Cells(l1, c1) <> ""
    txt1 = Split(Cells(l1, c1), ";", 3)
    txt2 = Split(Cells(l1, c2), ";", 3)
    c3 = 22
        
    c3 = c3 + 1
    Cells(l1, c3) = txt1(0)
    c3 = c3 + 1
    Cells(l1, c3) = txt2(0)
    If UBound(txt1) > 0 Then
       c3 = c3 + 1
       Cells(l1, c3) = txt1(1)
       c3 = c3 + 1
       Cells(l1, c3) = txt2(1)
    End If
    If UBound(txt1) > 1 Then
        c3 = c3 + 1
        Cells(l1, c3) = txt1(2)
        c3 = c3 + 1
        Cells(l1, c3) = txt2(2)
    End If
l1 = l1 + 1
Wend
End Sub

Cette macro ne remplace pas les colonnes U et V, ceci pour faire les tests.
Si ceux-ci sont concluants, modifies la ligne c3=22 en c3=20 et là les colonnes U et V seront remplacées.
 
Re : Déconcaténation double et tri parmi

Voila
Code:
Sub toto()
l1 = 3
c1 = 21
c2 = 22

first_line = 3
last_line = Cells(65536, 22).End(xlUp).Row

For l1 = first_line To last_line
    If Trim(Cells(l1, c1)) <> "" Then

        txt1 = Split(Cells(l1, c1), ";", 3)
        txt2 = Split(Cells(l1, c2), ";", 3)
        c3 = 22
            
        c3 = c3 + 1
        Cells(l1, c3) = txt1(0)
        c3 = c3 + 1
        Cells(l1, c3) = txt2(0)
        If UBound(txt1) > 0 Then
           c3 = c3 + 1
           Cells(l1, c3) = txt1(1)
           c3 = c3 + 1
           Cells(l1, c3) = txt2(1)
        End If
        If UBound(txt1) > 1 Then
            c3 = c3 + 1
            Cells(l1, c3) = txt1(2)
            c3 = c3 + 1
            Cells(l1, c3) = txt2(2)
        End If
    End If
Next
End Sub
 
Re : Déconcaténation double et tri parmi

Merci encore homepyrof53,

pour la petite précision que je t'avais demandé 😉

par contre j'ai voulu rajouter une condition au code, car parmi le vrai tableau il existe des erreurs dans les colonnes U et V: il se peut qu'il n'y ait que 2 données à déconcaténées en U et une seule date en V, voir une donnée en U et aucune en V.

Bref, de là j'ai voulu rajouter (en rouge):


Sub toto()
l1 = 3
c1 = 21
c2 = 22

first_line = 3
last_line = Cells(65536, 22).End(xlUp).Row

For l1 = first_line To last_line
If Trim(Cells(l1, c1)) <> "" Then

txt1 = Split(Cells(l1, c1), ";", 3)
txt2 = Split(Cells(l1, c2), ";", 3)
c3 = 20

c3 = c3 + 1
Cells(l1, c3) = txt1(0)
c3 = c3 + 1
Cells(l1, c3) = txt2(0)

If UBound(txt1) <> UBound(txt2) Then
Range("U" & l1).Interior.ColorIndex = 6
l1 = l1 + 1
End If

If UBound(txt1) > 0 Then
c3 = c3 + 1
Cells(l1, c3) = txt1(1)
c3 = c3 + 1
Cells(l1, c3) = txt2(1)
End If
If UBound(txt1) > 1 Then
c3 = c3 + 1
Cells(l1, c3) = txt1(2)
c3 = c3 + 1
Cells(l1, c3) = txt2(2)
End If
End If
Next
End Sub


De manière à ce que la macro passe à la ligne suivante si text1 et text2 n'ont pas la même longueur, et me colore en jaune la cellule en colonne U au passage.

Pourtant il me retoune une erreur 9': l'indice n'appartient pas à la sélection.
et me surligne la ligne : Cells(l1, c3) = txt2(0)

Merci d'avance,

M&m
 
Re : Déconcaténation double et tri parmi

Bonjour,

Voila la macro

Code:
Sub toto()
l1 = 3
c1 = 21
c2 = 22

first_line = 3
last_line = Cells(65536, 22).End(xlUp).Row

For l1 = first_line To last_line
    If Trim(Cells(l1, c1)) <> "" Then
'raz
        c3 = 22
        With Range(Cells(l1, c3 + 1), Cells(l1, c3 + 5))
            .ClearContents
            .Interior.ColorIndex = xlNone
            
        End With
        txt1 = Split(Cells(l1, c1), ";", 3)
        txt3 = Split(Cells(l1, c1))
        txt4 = Split(Cells(l1, c2))
        tmp = Cells(l1, c2) & " ; ; ; "
        txt2 = Split(tmp, "; ", 3)
 'référence 1
        c3 = c3 + 1: Cells(l1, c3) = txt1(0)
        c3 = c3 + 1: Cells(l1, c3) = txt2(0)
        If Trim(txt2(0)) = "" Then
           Cells(l1, c3 - 1).Interior.ColorIndex = 6
        Else
           Cells(l1, c3 - 1).Interior.ColorIndex = xlNone
        End If
'référence 2
        If UBound(txt1) > 0 Then
           c3 = c3 + 1: Cells(l1, c3) = txt1(1)
           c3 = c3 + 1: Cells(l1, c3) = txt2(1)
           If Trim(txt2(1)) = "" Then
              Cells(l1, c3 - 1).Interior.ColorIndex = 6
           Else
              Cells(l1, c3 - 1).Interior.ColorIndex = xlNone
           End If
        End If
'référence(s) suivante(s)
        If UBound(txt1) > 1 Then
            c3 = c3 + 1: Cells(l1, c3) = txt1(2)
            c3 = c3 + 1: Cells(l1, c3) = Mid(txt2(2), 1, Len(txt2(2)) - 6)
           If UBound(txt3) <> UBound(txt4) Then
              Cells(l1, c3 - 1).Interior.ColorIndex = 6
           Else
              Cells(l1, c3 - 1).Interior.ColorIndex = xlNone
           End If
        End If
    End If
Next
End Sub
 
Re : Déconcaténation double et tri parmi

Salut homepyrof53,

ta macro fonctionne pas mal sauf 2~3 petites choses:

je me suis aperçu que la dernière version laissait les colonnes de référence U et V: j'ai essayé de modifier c3=22 en c3=20 (comme sur le code précédent) mais cette méthode ne fonctionne pas.
J'ai rajouté :
(...)
Next

Columns("U:V").Select
Selection.Delete Shift:=xlToLeft

End Sub

Cette méthode ne fonctionne pas non plus, car j'ai l'impression que la macro continue de boucler même après avoir atteint la dernière ligne de données (j'ai vérifié en mode étape par étape lors de l'exécution du code), ce qui fait qu'après avoir supprimer les 2 colonnes, elle boucle de la même manière et beaucoup de cases jaunissent.

Sinon en ce qui concerne la coloration:

je pense que tu t'es compliqué la tâche; je voulais juste colorer les cellules des colonnes U et V sur les lignes où le nombre de données ne sont pas égales et passer à la suivante sans les déconcaténer car là par exemple dans mon "vrai" tableau, la macro s'arrête dans le cas où il y aurait 3 données en U et 2 dates en V mais peut être vais je tombé aussi sur 4 données et 1 date: tout cela pour dire de ne pas chercher au cas par cas juste:
un "If" qui contrôle que le nombre de données par ligne entre les celulles des colonnes U et V, sont égales et si elles ne le sont pas, colorer la celule de la colonne U et passer à la suivante.

et une dernière petite chose: lors de la déconcaténation certaines dates se modifient:

Ceci:
NAF-NPS-600604;NPS-SG-600256 08/02/2010; 09/02/2010

devient cela:
NAF-NPS-600604 02/08/2010 NPS-SG-600256 02/09/2010

Là-dessus je n'ai aucune idée par contre, car le "format de cellule" des cellules déconcaténées est bien réglé sur le format "14/03/2001" (le format FR): le format passe de dd/mm/yyyy à mm/dd/yyyy mais pas sur celle supérieur à 12 comme s'il détectait que en dessous de 12 il les inverse, au dessus il comprend qu'il n'y a pas plus de 12 mois de l'année et que par conséquent il devait la laissé telle quelle.

Voilà j'espère avoir éclairci les derniers points 😉 je pense qu'après ce post, mon problème sera résolu ^^

M&m
 
Dernière modification par un modérateur:
Re : Déconcaténation double et tri parmi

Bonjour,

c3 = 22
With Range(Cells(l1, c3 + 1), Cells(l1, c3 + 5))

si tu changes C3=20,
dans ce cas la ligne suivante doit être :
With Range(Cells(l1, 23), Cells(l1, 28))

je pense que le problème vient de là
 
Re : Déconcaténation double et tri parmi

1er problème de réglé :

si tu changes C3=20,
dans ce cas la ligne suivante doit être :
With Range(Cells(l1, 23), Cells(l1, 28))

c'est exactement ça !

2ème problème réglé:

de mon coté pour le format de date j'ai trouvé la soluce, il faut ajouter ".FormulaLocal" lors de la copie des cellules "dates" car sinon , de base, il te la copie au format UK.

Par contre, reste toujours celui du "contrôleur" If pour ne pas coder tous les cas de figure :

elle s'arrête tjs au cas où 3 données en U et 2 dates en V seulement.


M&m
 
Dernière modification par un modérateur:
Re : Déconcaténation double et tri parmi

Bonjour,

Je pense que cette situation peut durer un certain temps

Ne pourrais tu pas faire un fichier avec tous les cas possibles avec exemples en entrée et exemples en sortie
 
Re : Déconcaténation double et tri parmi

Après avoir examiner le tableau, j'ai relevé 4 cas cas de figures d'erreurs faisant s'arrêter la macro; lorsqu'il y a :

3 données en U et 2 dates en V
2 données en U et O dates en V
4 données en U et 2 dates en V
3 données en U et 1 dates en V

J'ai d'ailleurs mis à jour le tableau d'exemple avec ces 4 cas à la suite.

M&m
 

Pièces jointes

Re : Déconcaténation double et tri parmi

Bonjour,

voici la macro corrigée

Code:
Sub toto()
l1 = 3
c1 = 21
c2 = 22

first_line = 3
last_line = Cells(65536, 22).End(xlUp).Row

For l1 = first_line To last_line
    If Trim(Cells(l1, c1)) <> "" Then
'raz
        c3 = 22
        With Range(Cells(l1, 23), Cells(l1, 28))
            .ClearContents
            .Interior.ColorIndex = xlNone
            
        End With
        txt1 = Split(Cells(l1, c1), ";", 3)
        txt3 = Split(Cells(l1, c1))
        txt4 = Split(Cells(l1, c2))
        tmp = Replace(Cells(l1, c2), ";", " ;") & "  ;  ;  ;"
        txt2 = Split(tmp, "; ", 3)
 'référence 1
        c3 = c3 + 1: Cells(l1, c3) = txt1(0)
        c3 = c3 + 1
        If Trim(txt2(0)) = "" Then
           Cells(l1, c3 - 1).Interior.ColorIndex = 6
        Else
            Cells(l1, c3) = CDate(txt2(0))
            Cells(l1, c3 - 1).Interior.ColorIndex = xlNone
           
        End If
'référence 2
        If UBound(txt1) > 0 Then
            c3 = c3 + 1: Cells(l1, c3) = txt1(1)
            c3 = c3 + 1
            If Trim(txt2(1)) = "" Then
                Cells(l1, c3 - 1).Interior.ColorIndex = 6
            Else
                Cells(l1, c3) = CDate(txt2(1))
                Cells(l1, c3 - 1).Interior.ColorIndex = xlNone
            End If
        End If
'référence(s) suivante(s)
        If UBound(txt1) > 1 Then
            c3 = c3 + 1: Cells(l1, c3) = txt1(2)
'            c3 = c3 + 1: Cells(l1, c3) = Mid(txt2(2), 1, Len(txt2(2)) - 6)
            c3 = c3 + 1:
            tmp = Replace(txt2(2), "  ;", "")
            tmp = Replace(tmp, " ", "")
            tmp = Replace(tmp, ";", "; ")
            If Len(tmp) < 8 Then tmp = ""
            
            Cells(l1, c3) = tmp
           If UBound(txt3) <> UBound(txt4) Then
              Cells(l1, c3 - 1).Interior.ColorIndex = 6
           Else
              Cells(l1, c3 - 1).Interior.ColorIndex = xlNone
           End If
        End If
    End If
Next
End Sub
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Assurez vous de marquer un message comme solution pour une meilleure transparence.

Discussions similaires

Réponses
3
Affichages
315
Réponses
2
Affichages
282
Réponses
15
Affichages
776
Réponses
1
Affichages
328
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…