macro pour tri

Version imprimable

05/02/2011, 16h10
Bernardf57

macro pour tri

bonjour,

Une âme charitable pour resoudre mon probléme serait la bienvenu.Je veux trier les nombres d'une colonne A1=6 A2= 2 A3=10 et avoir le résultat dans la colonne B comme suis B1=2 B2=3 B3=1
05/02/2011, 16h48
Yolak

???
Quel tri étrange !!

Pourrais-tu développer ?
05/02/2011, 16h56
Bernardf57

La colonne A est figée je voudrais si cela est possible le classement dans la colonne B
05/02/2011, 17h02
Yolak

Mais quel est le rapport entre:
A1= 6
A2= 2
A3= 10

et
B1= 2
B2=3
B3= 1

Pour moi si je trie la colonne A, j'aurais plutôt B1= 2, B2=6, B3=10
05/02/2011, 17h07
Bernardf57

Excuse je m'explique mal :oops:

A sont des valeurs resultat de calcul
B sont leurs classements de la plus forte valeur à la plus faible
05/02/2011, 18h31
Yolak

Dsl mais je ne comprend toujours pas ...
Il va falloir que tu explique mieux que ça...
05/02/2011, 19h16
Bernardf57

A sont des valeurs resultat de calcul
B sont leurs classements de la plus forte valeur à la plus faible

A1 = 2 (Je veux afficher en b)............ B= 4 (------> QUATRIEME)
A2 = 5 ............. B= 3 (------> TROISIEME)
A3 = 10 ............. B= 1(-------> PREMIER)
A4 = 8 ............. B= 2 (-----> DEUXIEME)

Bonsoir,
C'est un peu scabreux mais bon c'est un début de piste. Lancer la proc "TrierPlage" :

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
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
 
Sub TrierPlage()
 
    Dim Plage As Range
    Dim Cel As Range
    Dim Tbl()
    Dim I As Integer
    Dim J As Integer
 
    'défini la plage
    With ActiveSheet
        Set Plage = .Range(.[A1], .[A65536].End(xlUp))
    End With
 
    'redimensionne le tableau au nombre de cellules de la plage
    ReDim Preserve Tbl(1 To 2, 1 To Plage.Count)
 
   'rempli le tableau avec les valeurs de la plage
    For I = 1 To Plage.Count
        Tbl(1, I) = Plage(I)
    Next I
 
    'effectue le tri du tableau
    Tri Tbl
 
    J = 1
    'le premier élément du tableau est le n°1
    Tbl(2, 1) = 1
 
    'défini les rangs
    For I = 2 To UBound(Tbl, 2)
        If Tbl(1, I) <> Tbl(1, I - 1) Then
            J = J + 1
            Tbl(2, I) = J
        Else
            Tbl(2, I) = J
        End If
    Next I
 
    'inscrit le rang de chaque valeur de la colonne A
    'dans la colonne B
    For Each Cel In Plage
        For I = 1 To UBound(Tbl, 2)
            If Cel = Tbl(1, I) Then
            Cel.Offset(0, 1) = Tbl(2, I)
            Exit For
            End If
        Next I
    Next Cel
 
End Sub
 
Sub Tri(Tbl())
 
    Dim Tempo
 
    Dim I As Integer
    Dim J As Integer
 
    For I = 1 To UBound(Tbl, 2) - 1
 
        For J = I + 1 To UBound(Tbl, 2)
            'pour un tri décroissant "<"
            'pour un tri croissant ">"
            If Tbl(1, I) > Tbl(1, J) Then
 
                Tempo = Tbl(1, J)
                Tbl(1, J) = Tbl(1, I)
                Tbl(1, I) = Tempo
 
            End If
 
        Next J
 
    Next I
 
End Sub

Hervé.

06/02/2011, 09h51
Bernardf57

Merci Hervé mais je crois que je vais continuer à remplir mon tableau en manuel.Trop compliqué pour moi :oops:
Mais ton programme fonctionne.Je vais quand même essayer d'incorporer ta macro dans ma feuille,mais il faudra que je change la selection des cellules et ne suis pas bon en VBA . Encore merci

La fonction d'Excel Rang
ici traduite en vba

Code:

1
2
3
4
5
6
7
8
9
Dim LastLig As Long
 
With Sheets("Feuil1")
   LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
   With .Range("B1:B" & LastLig)
      .FormulaR1C1 = "=Rank(RC[-1],R1C1:R" & LastLig & "C1,0)"
      .Value = .Value
   End With
End With

06/02/2011, 12h05
casefayere

En conclusion, si c'est trop compliqué pour
Bernardf57, formule dans B, recopie incrémentée

Code:

=RANG(A1;$A$1:$A$3;0)

A3 à remplacer par dernière ligne

:mouarf: merci mercatog, je ne me souvenais pas de cette fonction
06/02/2011, 12h15
Bernardf57

Merci à vous je l'ai incorporé dans ma feuille et cela fonctionne :ccool:

Bonne journée