Discussion :

[EngueEngue]

Messieurs, bonjour,

Relativement débutant en VBA je dispose d'un outil qui m'affiche certains résultats sous une forme non triée, je voudrais en faire un tri selon le critère d'une moyenne pondérée entre des résultats à la hausse et à la baisse.

Mon programme va récupérer le nombre total de triplets à trier en A1 de la feuille Triplets symétrie..
La pondération à la hausse et à la baisse dans la feuille lancement
Puis me construit un tableau avec les moyennes pondérées par indicateur.

Une fois mon tableau trouvé je le trie par ordre décroissant.

Jusque là tout va bien, je voudrais par la suite trier mon tableau qui est sous une forme assez complèxe:

Je me dis qu'il faut faire du range.copy range.paste mais je n'arrive pas y débuter..

Pourriez vous m'aider ?

Ci joint mon code, un fichier de test et l'organisation du tri:

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
Sub triermessymétries()
Dim dernlig As Long
Dim i As Long, j As Long
Dim TauxHausse As Double, TauxBaisse As Double
Dim tablo() As Double
 
Total = Sheets("Triplets symetrie").Range("A1")
ReDim tablo(1 To Total) As Double
TauxHausse = Sheets("Lancement").Range("D44")
TauxBaisse = Sheets("Lancement").Range("F44")
With Sheets("Triplets symetrie")
dernlig = .Range("k" & Rows.Count).End(xlUp).Row
j = 1
For i = 7 To dernlig Step 8
'tablohausses(j) = .Range("L" & i)
'tablobaisses(j) = .Range("K" & i)
tablo(j) = .Range("L" & i) * TauxHausse + .Range("K" & i) * TauxBaisse
j = j + 1
Next i
 
    Do 'tri décroissant
        Valeur = 0
 
        For i = 1 To UBound(tablo) - 1
            If tablo(i) < tablo(i + 1) Then
                Cible = tablo(i)
                tablo(i) = tablo(i + 1)
                tablo(i + 1) = Cible
                Valeur = 1
            End If
        Next i
    Loop While Valeur = 1
 
    'vérification du tri décroissant
    For i = 1 To UBound(tablo)
        Debug.Print tablo(i)
    Next i
 
End With
End Sub

Merci pour votre aide.

Bien à vous,
E

[Docmarti]

Il suffit d'ajouter une variable qui mémorise d'abord la position initiale (qui est 1,2,3) des 3 sections de ton tableau. Puis de modifier cette position à mesure que le tri s'effectue.
Ensuite tu pourras déplacer chaque section dans sa nouvelle position.

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
45
46
47
48
49
Sub triermessymétries()
Dim dernlig As Long
Dim i As Long, j As Long
Dim TauxHausse As Double, TauxBaisse As Double
Dim tablo() As Double
Dim Position() As Long
 
Total = Sheets("Triplets symetrie").Range("A1")
ReDim tablo(1 To Total) As Double
ReDim Position(1 To Total) As Long
 
TauxHausse = Sheets("Lancement").Range("D44")
TauxBaisse = Sheets("Lancement").Range("F44")
With Sheets("Triplets symetrie")
dernlig = .Range("k" & Rows.Count).End(xlUp).Row
j = 1
For i = 7 To dernlig Step 8
'tablohausses(j) = .Range("L" & i)
'tablobaisses(j) = .Range("K" & i)
tablo(j) = .Range("L" & i) * TauxHausse + .Range("K" & i) * TauxBaisse
Position(j) = j
j = j + 1
Next i
 
    Do 'tri décroissant
        Valeur = 0
 
        For i = 1 To UBound(tablo) - 1
            If tablo(i) < tablo(i + 1) Then
                Cible = tablo(i)
                tablo(i) = tablo(i + 1)
                tablo(i + 1) = Cible
 
                Cible = Position(i)
                Position(i) = Position(i + 1)
                Position(i + 1) = Cible
 
                Valeur = 1
            End If
        Next i
    Loop While Valeur = 1
 
    'vérification du tri décroissant
    For i = 1 To UBound(tablo)
        Debug.Print tablo(i); Position(i)
    Next i
 
End With
End Sub

[EngueEngue]

C'est ce à quoi j'ai pensé, j'ai fait un tableau à 2 dimensions et mon tri de la première va trainer la seconde dimension.

Sauf qu'une fois que j'ai mes positions je bloque sur le copiage des datas

Ex mon tableau trié va me donner (2,3,1) en positions

A10:L15 doit aller en A2:A7
A18:L23 doit aller en A10:L15
Et A2:A7 doit aller en A18:L23....

Comment le coder ?

[Docmarti]

Tu pourrais créer un array contenant l'adresse de chacune des 3 sections. Puis utiliser cet array pour faire un Copier/Coller de chaque section sur une feuille temporaire dans l'ordre obtenu par le tri.

[EngueEngue]

Je ne vois pas..
à titre informatif j'ai quelques milliers d'indicateurs.

[Docmarti]

Ajoute une feuille nommée TMP qui sera une feuille temporaire qui contiendra les sections de la feuille Triplets symetrie triées :

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
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
Sub triermessymétries()
Dim dernlig As Long
Dim i As Long, j As Long
Dim TauxHausse As Double, TauxBaisse As Double
Dim tablo() As Double
Dim Position() As Long
Dim Adresses() As String
Dim Origine As Worksheet
Dim DestTemp As Worksheet
 
Set Origine = Sheets("Triplets symetrie")
Set DestTemp = Worksheets("TMP")
 
Total = Origine.Range("A1")
ReDim tablo(1 To Total) As Double
ReDim Position(1 To Total) As Long
ReDim Adresses(1 To Total) As String
 
TauxHausse = Sheets("Lancement").Range("D44")
TauxBaisse = Sheets("Lancement").Range("F44")
With Origine
dernlig = .Range("k" & Rows.Count).End(xlUp).Row
j = 1
For i = 7 To dernlig Step 8
'tablohausses(j) = .Range("L" & i)
'tablobaisses(j) = .Range("K" & i)
tablo(j) = .Range("L" & i) * TauxHausse + .Range("K" & i) * TauxBaisse
Position(j) = j
 
'a - l
Adresses(j) = "A" & i - 5 & ":" & "L" & i + 2
 
 
j = j + 1
Next i
 
    Do 'tri décroissant
        Valeur = 0
 
        For i = 1 To UBound(tablo) - 1
            If tablo(i) < tablo(i + 1) Then
                Cible = tablo(i)
                tablo(i) = tablo(i + 1)
                tablo(i + 1) = Cible
 
                Cible = Position(i)
                Position(i) = Position(i + 1)
                Position(i + 1) = Cible
 
                'Adresses
                Cible = Adresses(i)
                Adresses(i) = Adresses(i + 1)
                Adresses(i + 1) = Cible
 
                Valeur = 1
            End If
        Next i
    Loop While Valeur = 1
 
    'vérification du tri décroissant
 
    premiere = 2
    DestTemp.Cells.Clear
    For i = 1 To UBound(tablo)
        Debug.Print tablo(i); Position(i); Adresses(i)
 
        Origine.Range(Adresses(i)).Copy DestTemp.Cells(premiere, 1)
 
        premiere = premiere + Origine.Range(Adresses(i)).Rows.Count
 
 
    Next i
 
End With
End Sub