[XL-2007] trier , code macro sur excel [Résolu]

[toga222]

Bonjour,
je suis entrain d'analyser des données sur excel , j'explique mon besoin
J'ai 3 colonnes sur excel

col1 col2 col3

x    v    z
x    z    o
y    v    r
a    v    p
m    k    s
e    n    f

Finalement je souhaite avoir ce tableau

col1 col2 col3

x    v    z
x    v    r
x    v    p
x    z    o
y    v    r
y    v    z

Voici ma problematique:
Est ce que v ous avez d'idées comment faire sous macro?
Cordialement
Toga222

[Daniel.C]

Bonjour,

Sers-toi de l’enregistreur de macros (vu le nombre de "v" en deuxième colonne, j'aurais du mal à t'aider.) Si tu ne sais pas te servir de l'enregistreur, reviens le dire. Ou alors, explique sur quoi tu veux trier.

[toga222]

Je simplifie
au départ j 'ai 3 colonnes sur excel
col1 col2

x v
x z
y v
a v
m k
e n
w v
w k
Finalement je souhaite avoir ce tableau
col1 col2 col3

x v y
x v a
x v w
y v x
y v a
y v w
et ainsi de suite
Cordialement
y v a


Voici ma problematique:
Est ce que v ous avez d'idées comment faire sous macro?
Cordialement
Toga222

[Daniel.C]

Comment passes-tu de
x v
à
x v y

???

[toga222]

Merci daniel ,
Donc, je pars sur la premiere ligne, x utilise v donc je recherche v dans la deuxieme colonne , si je la trouve, je recopie y dans la 3 eme colonne et ca donne
x v y et ainsi de suite
J'espere que c'est clair.
Cordialement,
Toga222

[Daniel.C]

et pourquoi pas m k w ?

[toga222]

Si vous avez raison ,
voici le tableau final complet:
x v y
x v a
x v w
y v x
y v a
y v w
m k n
e n
w v x
w v y
w v a
w k
Cordialement
Toga222

[Daniel.C]

Pas sûr que ce soit ce que tu veuilles avec les données en colonne A et B :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Sub test()
Dim c As Range, x As Range, Ligne As Long, Teste As Boolean
With Sheets("Feuil3")
.[D:F].ClearContents
Ligne = 1
For Each c In .Range(.[A1], .Cells(Rows.Count, 1).End(xlUp))
    .Cells(Ligne, 4) = c
    .Cells(Ligne, 5) = c.Offset(, 1)
    Teste = False
    For Each x In Range(.[B1], .Cells(Rows.Count, 2).End(xlUp))
        Var = x
        If x = c.Offset(, 1) And x.Row <> c.Row Then
            .Cells(Ligne, 6).Value = x.Offset(, -1).Value
            If .Cells(Ligne, 4) = "" Then .Cells(Ligne, 4) = .Cells(Ligne - 1, 4)
            If .Cells(Ligne, 5) = "" Then .Cells(Ligne, 5) = .Cells(Ligne - 1, 5)
            Ligne = Ligne + 1
            Teste = True
        End If
    Next x
    If Teste = False Then
        Ligne = Ligne + 1
    End If
Next c
End With
End Sub

[toga222]

Merci pour votre reponse,
Mais votre code trie la colonne b seulement et pas la premiere colonne.
Cordialement
toga222

[Daniel.C]

Le principe est le suivant. La macro parcourt la colonne A, reporte dans les colonnes D et E les valeurs des colonnes A et B. Elle recherche la valeur de la colonne B dans cette même colonne;s'il elle trouve une égalité, elle reporte la valeur de la colonne A correspondante dans la colonne F. Il n'y a pas de tri, tu n'as pas répondu à ma question sur le tri que tu as seulement mentionné dans le titre de ton message.

[toga222]

Bonjour,
le but c'est ne pas de trier , sinon j'aurai fait directement sans passer par un macro.
Mais, le votre donne :
x v y
m k w
x v a

et si vous remarquer mon tazbleau final doit etre sous cette forme:
x v y
x v a
x v w
y v x
y v a
y v w
m k n
e n
w v x
w v y
w v a
w k

Le but est : la colonne A présente les classes , la colonnes B présente les classe. La classe x utilise la table v donc on va chercher dans la premiere colonne quelles sont les classes reliées avec la table v et on stocke ces tables dans la 3 eme colonnes.
Mais on remarque bien que l'algorithm va trier la premiere colonne.
Cordialement

[Daniel.C]

Mais, le votre donne :
x v y
m k w
x v a

Mon résultat est:

x v y
x v a
x v w
x z
y v x
y v a
y v w
a v x
a v y
a v w
m k w
e n
w v x
w v y
w v a
w k m

Explique pourquoi la ligne :

x z

ne figure pas dans ton résultat.

[toga222]

Vous avez totalement raison:
je l'ai oublié, x z doit figurer

x v y
x v a
x v w
x z
y v x
y v a
y v w
m k n
e n
w v x
w v y
w v a
w k

Je viens de rexecuter le code les x de la premieres colonnes ne se suivent pas
Cordialement

bonjour avec ce tableau marche ,
x v
x z
y v
a v
m k
e n
w v
w k

Mais si on part sur ce tableau, qui est mon cas, ca ne marche pas
x v
y v
a v
x z
w v
m k
e n
w k

Cordialement

[mercatog]

Bonjour
et pourquoi n'y a t il pas un x z dans tes résultats alors que le e n existe?

Je trouve que l'explication par cet exemple est incomplète (peut être avec un fichier exemple comportant les données initiales et le résultat escompté serait plus compréhensible)

Sinon, une proposition

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Dim LastLig As Long, i As Long, j As Long, k As Long
Dim Res() As String, Tb
Dim Trouve As Boolean
 
Application.ScreenUpdating = False
With Worksheets("Feuil1")
    LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
    Tb = .Range("A2:B" & LastLig)
    For i = 1 To LastLig - 1
        j = 0
        Trouve = False
        Do While j < LastLig - 1
            j = j + 1
            If i <> j Then
                If Tb(i, 2) = Tb(j, 2) Then
                    k = k + 1
                    ReDim Preserve Res(1 To 3, 1 To k)
                    Res(1, k) = Tb(i, 1)
                    Res(2, k) = Tb(i, 2)
                    Res(3, k) = Tb(j, 1)
                    Trouve = True
                End If
            End If
        Loop
        If Not Trouve Then
            k = k + 1
            ReDim Preserve Res(1 To 3, 1 To k)
            Res(1, k) = Tb(i, 1)
            Res(2, k) = Tb(i, 2)
        End If
    Next i
    .Range("E2").Resize(UBound(Res, 2), UBound(Res, 1)) = Application.Transpose(Res)
End With

[toga222]

bonjour,
Le premier macro repond bien a mon besoin en triant la premiere colonne de a à Z
Je vous remercie
Cordialement

[toga222]

Bonjour,
Je souhaite modifier le premier code pour obtenir le tableau 2 à partir du tableau 1 :

tableau 1:

x v
x z
y v
m k
e n
w v
w k
résultat attendu:
x v x
x v y
x v w
x z x
y v y
y v x
y v w
m k m
m k w
e n e
w v w
w v x
w v y
w k w
w k m.
Merci
Toga222

[mercatog]

Bonjour
malheureusement j'ai pu adapter le code que j'avais proposé pour arriver au nouveau résultat souhaité

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Dim LastLig As Long, i As Long, j As Long, k As Long
Dim Res() As String, Tb
Dim Trouve As Boolean
 
Application.ScreenUpdating = False
With Worksheets("Feuil1")
    LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
    Tb = .Range("A2:B" & LastLig)
    For i = 1 To LastLig - 1
        j = 0
        Trouve = False
        Do While j < LastLig - 1
            j = j + 1
            If Tb(i, 2) = Tb(j, 2) Then
                k = k + 1
                ReDim Preserve Res(1 To 3, 1 To k)
                Res(1, k) = Tb(i, 1)
                Res(2, k) = Tb(i, 2)
                Res(3, k) = Tb(j, 1)
                Trouve = True
            End If
        Loop
        If Not Trouve Then
            k = k + 1
            ReDim Preserve Res(1 To 3, 1 To k)
            Res(1, k) = Tb(i, 1)
            Res(2, k) = Tb(i, 2)
        End If
    Next i
    .Range("E2").Resize(UBound(Res, 2), UBound(Res, 1)) = Application.Transpose(Res)
End With

[toga222]

Merci mercatog pour votre reponse, le code fonctionne bien à condition qu'il faut sauter une ligne au début.
Comment faire pour le faire fonctionner sans inserrer une ligne vide au debut de fichier excel? et pourqu'il execute le resultat dans une deuxieme feuille excel?
Cordialement

[mercatog]

J'avais supposé à tort que la ligne 1 était la ligne des titres.
Si les données commencent en ligne 1

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Dim LastLig As Long, i As Long, j As Long, k As Long
Dim Res() As String, Tb
Dim Trouve As Boolean
 
Application.ScreenUpdating = False
With Worksheets("Feuil1") ' a adapter
    LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
    Tb = .Range("A1:B" & LastLig)
    For i = 1 To LastLig
        j = 0
        Trouve = False
        Do While j < LastLig
            j = j + 1
            If Tb(i, 2) = Tb(j, 2) Then
                k = k + 1
                ReDim Preserve Res(1 To 3, 1 To k)
                Res(1, k) = Tb(i, 1)
                Res(2, k) = Tb(i, 2)
                Res(3, k) = Tb(j, 1)
                Trouve = True
            End If
        Loop
        If Not Trouve Then
            k = k + 1
            ReDim Preserve Res(1 To 3, 1 To k)
            Res(1, k) = Tb(i, 1)
            Res(2, k) = Tb(i, 2)
        End If
    Next i
    .Range("E1").Resize(k, 3) = Application.Transpose(Res)
End With

[toga222]

merci !