Trier des lignes

Le 30/08/2015 à 20:14

Bonjour tout le monde !

Voilà, j'ai un tableau (rouge en pj) de 2 colonnes et 1920 lignes avec 128 valeurs différentes. Chacune de ces valeurs apparaît 15 fois dans la colonne A et 15 fois dans la colonne B.

Le but du jeu: trier ces lignes dans 15 paires de colonnes différentes (jaunes dans la pj) de sorte que dans chacune de ces paires, chacune des 128 valeurs apparaisse 1 fois dans la 1e colonne et 1 fois dans la 2e colonne.

Bien sûr la valeur en a1 doit rester collée à la valeur b1, la valeur a2 couplée à la valeur b2, etc.

Merci d'avance pour vos conseils et bonne soirée...

24question.xlsx (44.52 Ko)
Le 31/08/2015 à 00:37

Bonsoir Jecomprendsrien, bonsoir le forum,

Essaie le code ci-desous :

Sub Macro1()
Dim TC As Variant 'déclare la variable TC (Tableau de Cellules)
Dim NL As Integer 'déclare la variable NL (Nombre de Lignes)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim I As Integer 'déclare la variable I (Incrément)
Dim TMP As Variant 'déclare la variable TMP (Tableau TeMPoraire)
Dim PL As Range 'déclare la variable PL (PLage)
Dim LI As Integer 'déclare la variable LI (LIgne)
Dim COL As Integer 'déclare la variable COL (COLonne)
Dim R As Range 'déclare la variable R (Recherche)
Dim PA As String 'déclare la variable PA (Première Adresse)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
TC = Range("A1").CurrentRegion 'définit le tableau de cellules TC
NL = UBound(TC, 1) 'définit le nombre de ligne NL du tableau de cellules TC
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For I = 1 To NL 'boucle sur toutes les lignes I du tableau de cellules TC
    D(TC(I, 1)) = "" 'alimente le dictionnaire D avec la valeur ligne I colonne 1 de TC
Next I 'prochaine ligne de la boucle
TMP = D.keys 'récupère dans le tableau temporaire TMP la liste des éléments du dictionnaire D sans doublon
Set PL = Range("A1:A" & NL + 1) 'définit la plage PL
For I = 0 To UBound(TMP) 'boucle sur tous les éléments du tableau temporaire TMP
    COL = 4 'initialise la colonne COL
    Set R = PL.Find(TMP(I), Cells(NL + 1, 1), xlValues, xlWhole) 'définit la recherche R
    If Not R Is Nothing Then 'condition : si il existe au moins une occurrence trouvée
        PA = R.Address 'définit l'adresse PA de la première occurrence trouvée
        Do 'exécute
            'définit la ligne LI (première cellule vide de la colonne COL)
            LI = IIf(Cells(1, COL).Value = "", 1, Cells(Application.Rows.Count, COL).End(xlUp).Row + 1)
            'revoie dans la cellule ligne LI colonne COL la valeur de l'occurrence trouvée R
            Cells(LI, COL) = R.Value
            'revoie dans la cellule ligne LI colonne COL +1 la valeur de l'occurrence trouvée décalée d'une colonne à droite
            Cells(LI, COL + 1).Value = R.Offset(0, 1).Value
            COL = COL + 3 'incrémente la colonne COL de 3
            Set R = PL.FindNext(R) 'redéfinit la recherche R (occurrence suivante)
        Loop While Not R Is Nothing And R.Address <> PA 'boucle tant qu'il existe de nouvelles occurrence ailleurs qu'en PA
    End If 'fin de la condition
Next I 'prochaine élément du tableau temporaire TMP
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
MsgBox "Opération terminée !" 'message
End Sub
Le 01/09/2015 à 07:08

Bonjour Thau Theme et merci d'avoir pris le temps de répondre !

J' essaierai le code aujourd'hui ou demain. Je ne manquerai pas de vous dire si ça a marché.

A bientôt et merci encore

Le 01/09/2015 à 13:57

Re-bonjour Thau Theme,

J'ai essayé le code et ça marche. Je suis content car je n'ai pas eu souvent l'occasion de lancer des macros.

Ceci dit, pour certaines paires de colonnes certaines valeurs reviennent 3 fois (au lieu de 2) et d'autres 1 seule fois...

Y aurait-il un moyen pour corriger ceci ?

Encore merci

Le 01/09/2015 à 14:26

Re,

As-tu vérifié si ce n'était pas déjà le cas dans les deux colonnes originales car le code ne fait que le renvoie d'une recherche...

Le 01/09/2015 à 17:16

Oui, oui j'ai bien vérifié. Chaque valeur se trouve bien 30 fois dans le tableau de départ (15 fois dans la colonne de gauche, 15 fois dans celle de droite)

Par contre, dès que je lance la macro, j'obtiens un décalage dès la 4e paire de colonnes...

Bizarre, non ?

Le 01/09/2015 à 17:29

Re,

J'ai fait tourner le code pas à pas et me suis rendu compte qui remplissait les données en ligne et non pas en colonne. D'où les problèmes... Il faut que je revoie le code car il n'est pas fiable. J'y travaille...

Le 03/09/2015 à 00:21

Re,

Désolé, je n'y arrive pas ! Mais je continue mes recherches...

Le 03/09/2015 à 12:17

Bonjour Jecomprensrien, bonjour le forum,

Je crois que ça y est !...

Option Explicit 'oblige à déclarer toutes les variables
Option Base 1 'débute les index de tableaux à 1 (au lieu de 0)

Sub Macro1()
Dim PL As Range 'déclare la plage PL (PLage)
Dim TC As Variant 'déclare la variable TC (Tableau de Cellules)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim I As Integer 'déclare la variable I (Incrément)
Dim TMP As Variant 'déclare la variable TMP (tableu TeMPoraire)
Dim COL As Byte 'déclare la variable COL (Colonne)
Dim J As Byte 'déclare la variable J (Incrément)
Dim T128(15) 'déclare la variable T128 (15 Tableaux de cellules)
Dim R As Range 'déclare la variable R (Recherche)
Dim PA As String 'déclare la variable PA (Première Adresse)
Dim TEST As Boolean 'déclare la variable TEST
Dim K As Integer 'déclare la variable K (Incrément)
Static LI As Integer 'déclare la variable LI (LIgne)

'************************************************************
'extrait les valeurs uniques en colonne A dans le tableau TMP
'************************************************************
TC = Range("A1:A1920") 'définit le tableau de cellules TC
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For I = 1 To 1920 'boucle sur toutes les lignes I du tableau de cellules TC
    D(TC(I, 1)) = "" 'alimente le dictionaire D avec les valeurs ligne I colonne 1 de TC
Next I 'prochaine ligne de la boucle
TMP = D.keys 'récupère dans le tableau temporaire TMP la liste des éléments du dictionnaire D sans doublon

'********************************************************************************
'Crée 15 tableaux de cellules où reront renvoyées les données des colonnes A et B
'********************************************************************************
COL = 4 'initialise la colonne COL
For J = 1 To 15 'boucle sur 15 valeurs
    T128(J) = Range(Cells(1, COL), Cells(128, COL + 1)) 'définit le tableau de cellules T128(J)
    COL = COL + 3 'redéfinit la colonne COL
Next J 'prochaine valeur de la boucle

'**********************************************
'dispatching des données dans les tableaux T128
'**********************************************
Set PL = Range("A1:A1921") 'définit la plage PL
For I = 0 To UBound(TMP) 'boucle 1 : sur tous les éléments du tableau temporaire TMP
    Set R = PL.Find(TMP(I), Range("A1921"), xlValues, xlWhole) 'définit la recherche R (recherche l'élément dans la plage PL)
    If Not R Is Nothing Then 'condition 1 : si il existe au moins une occurrence trouvée
        PA = R.Address 'définit l'adresse de la première occurrence trouvée
        Do 'exécute
            For J = 1 To 15 'boucle 2 : sur les 15 tableaux T128
                TEST = False 'initialise la variable TEST
                For K = 1 To 128 'boucle 3 : sur les 128 lignes du tableau T128(J)
                    If T128(J)(K, 1) = R.Value Then 'condition 2 : si la valeur en ligne K colonne 1 du tableau T128(J) est égale à la valeur cherchée
                        TEST = True 'définit la variable TEST
                        GoTo suite 'va à l'étiquette "suite"
                    End If 'fin de la condition 2
                Next K 'prochaine ligne de la boucle 3
                If TEST = False Then 'condition 3: si TEST est [vrai]
                    LI = 0 'initialise la ligne LI
                    For K = 1 To 128 'boucle 4 : sur les 128 lignes du tableau T128(J)
                        'si la valeur ligne K, colonne 1 de T128(J) est vide, définit la ligne LI (=1 si LI est égale à 0, sinon la ligne K de la valeur vide)
                        If T128(J)(K, 1) = Empty Then LI = IIf(LI <> 0, LI, K)
                        'si la valeur ligne K colonne 2 de T128(J) est égale à la valeur de la cellule décalée d'un colonne à droite de la cellule de la valeur trouvée,
                        'va à l'étiquette "suite"
                        If T128(J)(K, 2) = R.Offset(0, 1).Value Then GoTo suite
                    Next K 'prochaine ligne de la boucle 4
                    T128(J)(LI, 1) = R.Value 'définit la valeur ligne LI colonne 1 de T128(J)
                    T128(J)(LI, 2) = R.Offset(0, 1).Value 'définit la valeur ligne LI colonne 2 de T128(J)
                    GoTo fin 'va 'à l'étiquette "fin"
                End If 'fin de la condition 3
suite: 'étiquette
            Next J 'prochain tableau de la boucle 2
fin: 'étiquette
            Set R = PL.FindNext(R) 'redéfinit la rechercher R (occurrence suivante)
        Loop While Not R Is Nothing And R.Address <> PA 'boucle tant qu'il existe de nouvelles occurrences ailleurs qu'en PA
    End If 'fin de la condition 1
Next I 'prochain élément du tableau temporaire TMP

'**************************************************
'renvoi des données des tableaux T128 dans l'onglet
'**************************************************
COL = 4 'initialise la colonne COL
For J = 1 To 15 'boucle sur 15 tableaux
    Cells(1, COL).Resize(128, 2).Value = T128(J) 'renvoie la valeur du tableau dans la cellule ligne 1 colonne COL de l'onglet
    COL = COL + 3 'redéfinit la colonne COL
Next J 'prian tableau de la boucle
MsgBox "Tranfert terminé !" 'message
End Sub
Le 03/09/2015 à 17:44

Bonjour Thau Thème

ça fonctionne ! Génial !

Ceci dit, il reste un truc curieux : quand on modifie l'ordre des lignes et qu'on exécute la macro, certaines valeurs ne sont pas déplacées dans les nouvelles colonnes.

A toute fin utile je joins le résultat que ça donne suite à une modification du tableau de départ. Je précise bien que seul l'ordre des lignes a été modifié et que j'ai fait l'essai sur un nouveau classeur.

Si vous avez une explication, je suis preneur...

Merci infiniment encore pour le temps passé !

18question-bis.xlsx (53.20 Ko)
Le 03/09/2015 à 19:35

Re,

J'ai regardé pas à pas et je suis arrivé à la conclusion que mon code n'était pas fiable du tout.

Ton problème ressemble un peu au sudoku en ce sens que dans une colonne il ne peut y avoir deux fois la même valeur. Le code lui, vérifie si la première valeur existe et définit le la colonne en fonction. Ensuite il vérifie si la deuxième valeur existe dans la colonne adjacente. Si elle n'existe pas il place alors la deuxième valeur. Mais rien ne dit que c'est la position idéale car dès qu'il a trouvé un "trou" correspondant il place les valeurs et s'arrête. On pourrait placer la paire dans un autre tableau qui lui aussi vérifierai les conditions. Et c'est là qu'est le problème ! Dans ton dernier exemple tout va bien jusqu'à la quinzième paire de la ligne 14. La paire est 125/101 mais 101 se trouve déjà dans la colonne 2 du 15ème tableau. Donc, la boucle lui dit de passer au suivant. Ça génère un décalage qui s'accentue par la suite... Je me demande par quel miracle ça ne le faisait pas dans l'exemple précédent.

Désolé mais je ne pense pas être en mesure de trouver une code qui fonctionne !

Le 04/09/2015 à 19:18

Bonsoir

Je crois effectivement comprendre quel est le problème. En tout cas, merci beaucoup pour vos efforts et le temps consacré.

N'hésitez pas à me recontacter si jamais vous pensez trouver une solution.

Encore merci

Rechercher des sujets similaires à "trier lignes"