trier , code macro sur excel

Version imprimable

05/10/2011, 16h55
toga222

trier , code macro sur excel
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
05/10/2011, 17h14
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.
05/10/2011, 17h15
toga222

code macro excel

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
05/10/2011, 17h21
Daniel.C

Comment passes-tu de
x v
à
x v y

???
05/10/2011, 17h41
toga222

macro excel

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
05/10/2011, 17h51
Daniel.C

et pourquoi pas m k w ?
05/10/2011, 17h59
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

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

06/10/2011, 09h51
toga222

Merci pour votre reponse,
Mais votre code trie la colonne b seulement et pas la premiere colonne.
Cordialement
toga222
06/10/2011, 10h09
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.
06/10/2011, 10h22
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
06/10/2011, 10h43
Daniel.C

Citation:

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.
06/10/2011, 11h15
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

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

06/10/2011, 11h34
toga222

bonjour,
Le premier macro repond bien a mon besoin en triant la premiere colonne de a à Z
Je vous remercie
Cordialement
10/10/2011, 08h48
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

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

10/10/2011, 13h17
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

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

10/10/2011, 14h46
toga222

merci !