Discussion :

[VBA_girl]

Bonjour,

Je m’adresse à vous aujourd’hui après de longues recherches infructueuses sur des forums.
Mon problème parait simple, mais pourtant je ne trouve pas de sujets qui le traitent.

Voila, j’ai un tableau qui contient différentes colonnes.
J’aimerai classer les données de la première colonne par ordre croissant et pouvoir retrouver les données correspondantes.
Globalement j’aimerai pouvoir changer l’ordre des lignes en suivant le trie effectuée sur la première colonne.
J’ai essayé avec le code ci-dessous, il marche bien mais le problème se situe quand j’ai pour deux lignes la même valeur dans la 1ére colonne mais des valeurs différentes dans la suite de la ligne. Dans ce cas après la recherche il va toujours sortir la 1ére ligne correspondante et je me retrouve alors avec des lignes identiques.

Je ne sais pas si j’ai été assez claire, si ce n’est pas le cas voici mon fichier en pièce jointe il vous permettra de vous faire une idée.

Merci d’avance pour votre aide.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
34
35
36
37
38
39
40
41
42
43
44
 
Private Sub CommandButton1_Click()
 
ActiveSheet.CommandButton1.Caption = "trier données "
 
Dim i, j, b, a As Integer
Dim nb_exch As Integer
 
 
nb_exch = Range(Cells(7, 5), Cells(7, 5).End(xlToRight)).Count
 
Range(Cells(85, 3), Cells(200, 12)).ClearContents
 
 
Range(Cells(71, 3), Cells(74, 3).End(xlToRight)).Select 'transpose le tableau
    Selection.Copy
    Range("C86").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
 
Range(Cells(88, 3), Cells(88, 3).End(xlDown)).Select    'reprend la première colonne du tableau et la coller
    Selection.Copy
    Range("C117").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False
 
Range(Cells(117, 3), Cells(177, 3).End(xlDown)).Select   'trie la 1ére colonne du tableau du plus petit au plus grand
    Selection.Sort Key1:=Range("C117"), Order1:=xlAscending, Header:=xlGuess _
        , OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
     DataOption1:=xlSortNormal
 
With Sheets("trier")
For j = 1 To 4
 For i = 1 To nb_exch
'recherche les valeurs correspondantes aux données de la 1ére colonne
  .Cells(116 + i, 3 + j).Value = WorksheetFunction.VLookup(.Cells(116 + i, 3).Value, Sheets("trier").Range(Cells(88, 3), Cells(114, 7)), 1 + j, False) 'cold side
 
  Next i
 
   Next j
 
  End With
 
End Sub

Trie.xls

[Gestionnaire_rh]

Bonjour,

je n'ai pas compris votre méthode, faire un trie pour extraire une information suite a une recherchev et pourtant elle est bien renseigner ( avec le 04 argument qui égale a "false", a mes connaissances avec ce dernier argument rien ne vous oblige a faire le trie pour la recherchev), et puis le problème de lignes identiques quelle est le résultat que voulez avoir et merci de définir les plages dans ton explicite.

Cordialement

Gestionnaire_rh

[VBA_girl]

Bonjour Gestionnaire_rh,

Effectivement pour faire une rechercheV nous n'avons pas besoin de trier, mais ce trie m'est utile dans la suite de mon programme.

Le resultat souhaité est une 1ére colonne triée du plus petit nombre au plus grand nombre, et mettre la ligne contenant les informations correspondants a la case dans 1ére colonne aprés le trie.

J'ai mis un exemple de ce que je voulais obtenir dans le fichier excel suivant.

Merci d'avance!

[GuyXL]

Bonjour,

Sous réserve d'avoir bien compris la problématique, une solution n'utilisant pas la recherche V ni le tableau intermédiaire mais seulement, éventuellement, des tris secondaires. Fichier joint. Cordialement

R

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
34
35
36
37
38
39
40
41
42
Private Sub CommandButton1_Click()
 
Dim nb_exch%, tb%(), i%
'nb echantillons
nb_exch = Range(Cells(7, 5), Cells(7, 5).End(xlToRight)).Count
'nettoyage
With Range(Cells(86, 1), Cells(Rows.Count, Columns.Count))
    .Borders.LineStyle = xlNone
    .ClearContents
End With
'transposition tableau
Range(Cells(71, 3), Cells(74, 3).End(xlToRight)).Copy
Cells(86, 3).PasteSpecial Paste:=xlPasteValues, Transpose:=True
'tri 1ère colonne
Range(Cells(88, 3), Cells(87 + nb_exch, 6).End(xlDown)).Sort Key1:=Cells(88, 3), _
    Order1:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
    Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
'repérage des doublons (triplets...) selon 1ère colonne
ReDim tb(1 To nb_exch): tb(1) = 1
For i = 2 To nb_exch
    If Cells(87 + i, 3) <> Cells(86 + i, 3) Then
        tb(i) = 1
    Else
        tb(i) = tb(i - 1) + 1
        tb(i - 1) = 1
    End If
Next i
'tris partiels supplémentaires éventuels des doublons (triplets...) selon 2ème colonne
For i = 2 To nb_exch
    If tb(i) > 1 Then
        Range(Cells(88 + i - tb(i), 3), Cells(87 + i, 6)).Sort Key1:=Cells(88 + i - tb(i), 4), _
            Order1:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
            Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
    End If
Next i
'format
With Range(Cells(86, 3), Cells(87 + nb_exch, 6)).Borders
    .LineStyle = xlContinuous
    .Weight = xlThin
End With
 
End Sub

[gFZT82]

Bonjour VBA_girl,

Voici une solution de tri personnalisé obtenue avec l'enregistreur de macro.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Private Sub CommandButton1_Click()
    ActiveSheet.CommandButton1.Caption = "trier données "
    Dim i, j, b, a As Integer
    Dim nb_exch As Integer
 
    nb_exch = Range(Cells(7, 5), Cells(7, 5).End(xlToRight)).Count
    Range(Cells(85, 3), Cells(200, 12)).ClearContents 'efface les formules de la plage.
 
    'Transpose le tableau
    Range(Cells(71, 3), Cells(74, 3).End(xlToRight)).Copy
    Range("C86").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
 
    'Copier coller du tableau
    Range(Cells(86, 3), Cells(86, 6).End(xlDown)).Copy
    Range("C115").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False
 
    'Tri personnalisé du tableau
    ActiveWorkbook.Worksheets("trier").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("trier").Sort.SortFields.Add Key:=Range("C117:C129" _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("trier").Sort.SortFields.Add Key:=Range("D117:D129" _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("trier").Sort
        .SetRange Range("C117:F129")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Cordialement.

[VBA_girl]

Coucou,

Merci a GuyXL et gFZT82 pour vos réponses toutes aussi intéressantes.

J'ai opté pour la réponse de GuyXL finalement car elle reste plus flexible quand a la longeur de mes tableaux qui varie sans cesse selon les données.

Encore un énorme merci, ca faisait un moment que je galérais la dessus.. je pense que je reviendrai sur ce forum asez souvent

A bientot