Associer LEFT et RANGE en VBA

**curt** · 19/08/2019, 21h18

Bonsoir à tous,

j'ai un module qui fonctionne très bien :

Code :

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

1
2
3
4
5
6
Sub tri1()
 
    Range("A1").CurrentRegion.Sort key1:=Range("C1"), order1:=xlAscending, dataoption1:=xlSortNormal, _
                                   key2:=Range("B1"), order2:=xlAscending, dataoption2:=xlSortNormal, Header:=xlYes
 
End Sub

ça effectue le tri du tableau en prenant comme critère la colonne C et la colonne B

L'embêtant est que j'ai dû créer une colonne intermédiaire (la colonne C) pour avoir le premier caractère gauche de la cellule A correspondante.
Est-il possible de supprimer cette colonne C et traiter directement le tri par ce code (qui lui ne fonctionne pas) :

Code :

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

1
2
Range("A1").CurrentRegion.Sort key1:=Left(Range("A1"), 1), order1:=xlAscending, dataoption1:=xlSortNormal, _
                                   key2:=Range("B1"), order2:=xlAscending, dataoption2:=xlSortNormal, Header:=xlYes

Merci d'avance du coup de main.

Curt

Invité · 20/08/2019, 03h48

Envoyé par curt

Bonjour,

A tester:

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
 
Sub TestTriSelonColonnesAetB()
 
    TriSelonColonnesAetB Sheets("Feuil1"), 1
    MsgBox "Fin du tri !", vbInformation
 
End Sub
 
Sub TriSelonColonnesAetB(ByVal FeuilleATrier As Worksheet, LigneDeTitre As Long)
 
Dim I As Long, DerniereLigne As Long, ColonneTri As Long
Dim AireATrier As Range
Dim AireColonneATrier As Range
 
    Application.ScreenUpdating = False
 
    With FeuilleATrier
 
         ColonneTri = .Cells(LigneDeTitre, .Columns.Count).End(xlToLeft).Column + 1
         .Cells(LigneDeTitre, ColonneTri) = "Tri"
         DerniereLigne = .Cells.SpecialCells(xlCellTypeLastCell).Row
         If DerniereLigne = LigneDeTitre Then Exit Sub
 
         For I = LigneDeTitre + 1 To DerniereLigne
             .Cells(I, ColonneTri) = Left(.Cells(I, 1), 1) & .Cells(I, 2)
         Next I
 
         Set AireATrier = .Range(.Cells(LigneDeTitre, 1), .Cells(DerniereLigne, ColonneTri))
         Set AireColonneATrier = .Range(.Cells(LigneDeTitre, ColonneTri), .Cells(DerniereLigne, ColonneTri))
 
         .Sort.SortFields.Clear
         .Sort.SortFields.Add Key:=AireColonneATrier, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
         With .Sort
              .SetRange AireATrier
              .Header = xlYes
              .MatchCase = False
              .Orientation = xlTopToBottom
              .SortMethod = xlPinYin
              .Apply
         End With
 
         AireColonneATrier.Clear
 
         Set AireColonneATrier = Nothing
         Set AireATrier = Nothing
 
    End With
 
    Application.ScreenUpdating = True
 
End Sub

**curt** · 20/08/2019, 10h10

Bonjour Eric et merci pour cette réponse qui fonctionne. (petit pouce en l'air en prime)

Mais mon but était de supprimer cette colonne C intermédiaire, pas d'en créer une même temporaire.

Merci du coup de main en tout cas.

Curt

**Pierre Fauconnier** · 20/08/2019, 10h29

Salut Curt,

Je n'ai pas bien compris le besoin. Trier sur le premier caractère de A ne revient-t-t-il pas à trier sur A? Ne peux-tu donc pas trier sur B-A directement?

Invité · 20/08/2019, 10h38

Envoyé par Pierre Fauconnier

Salut Pierre,

Pour info :
Pièce jointe 498435

Philippe reconnaîtra son générateur de noms et de dates qui sert toujours....

**curt** · 20/08/2019, 11h12

Bonjour à tous et merci de vos réponses.

je vais expliciter le sujet :
J'ai une liste de documents qu'on triée à partir des indices (a, b, c, etc...)
Sans rien changer à cette liste existante, il est demandé de pouvoir "indicer" les indices à savoir de pouvoir traiter (et dans cet ordre) a b1 b2 b3 b c d e1 e2 e3 e
Pour être encore plus clair il existe des indices internes appelés OUVERT (diffusion sous-traitants, chantier) qui ouvrent (comme le nom l'indique) une nouvelle diffusion. Il peut y avoir n indices numériques avant que la diffusion officielle soit faite.

Revenons à ma question et au sujet de ce post :
Je ne peux pas ajouter de colonne (pas même temporaire)
Si j'utilise le tri sur la colonne INDICE, je me retrouve avec c, c1,c10,c11,c12..... c2, c20 - ce qui ne correspond pas à la réalité.

Je regarde en ce moment à trier sur les dates mais ça ne me semble pas judicieux puisque le nombre sous-traitants, chantier etc n'est jamais connu d'une affaire à l'autre.

Merci d'avance pour le coup de main.
Curt

Invité · 20/08/2019, 11h24

Envoyé par curt

Si je comprends bien, il ne faut toucher à rien dans le tableau mais être en mesure de faire un tri.
Par rapport à mon code, il suffit de charger les valeurs de ma colonne temporaire dans une matrice qui doit contenir également la ligne d'origine du tableau et de trier la matrice.

**curt** · 20/08/2019, 11h28

Eric, je penses tu as parfaitement compris le problème.

**laurent_ott** · 21/08/2019, 10h38

Bonjour à vous tous.
j'ai pensé à deux solutions pour résoudre ce problème de tri sans ajouter une colonne temporaire.
Une simple et une compliquée.

La simple:
- utiliser une colonne existante (par exemple le nom), pour y mettre la clé calculée mais sans supprimer le contenu de la cellule, c'est à dire mettre la clé + un trait (ou autre signe distinctif) + le nom d'origine;
- trier le tableau sur cette colonne;
- supprimer dans cette colonne la clé pour ainsi restaurer le nom d'origine.

La compliquée:
- mémoriser toutes les données du tableau;
- mettre la clé calculée dans une mémoire;
- générer le classement (et pas le tri, la différence est importante) de cette mémoire;
- affecter les données du tableau préalablement mémorisées en utilisant l'ordre du classement obtenu.

Par curiosité j'ai utilisé la solution compliquée:
Pour générer le classement j'ai utilisé une variante de QuickSort (simplifiée) mais vous pouvez prendre QuickRanking (voir dans ma signature les tomes 1 et 6).
Ici le tableau est en C10 mais vous pouvez utiliser un nom tout simplement.

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
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
Option Explicit
 
'-------------------------------------------------------------------------------
Public Sub Classer()
'-------------------------------------------------------------------------------
Dim TabDonnées() As Variant
Dim Classement() As Long
Dim Tableau As Range
Dim i As Long, x As Integer, y As Long
 
' Mémorise les données du tableau (y compris l'entête) en base 1
' Ici la cellule haut gauche du tableau est en C10, le plus propre est de nommer cette
' cellule est d'utiliser le nom:
Set Tableau = [C10].CurrentRegion.Cells
 
' Redimensionne la mémoire qui contiendra les données (sans l'entête) en base 0:
ReDim Mémo(0 To UBound(Tableau()) - 2, 0 To Tableau.Count / UBound(Tableau()))
 
' Mémorise les données en base 0 sans l'entête:
For i = 2 To UBound(Tableau())
    For x = 1 To Tableau.Count / UBound(Tableau())
        Mémo(i - 2, x - 1) = Tableau(i, x)
    Next x
Next i
 
' Redimensionne la mémoire qui contiendra la clé de tri en base 0:
ReDim TabDonnées(0 To UBound(Mémo()))
 
' Génère une clé stockée dans TabDonnées en base 0.
' Ici c'est la 1ère lettre de la 1ère colonne + la 1ère lettre de la 2ème colonne:
For i = 0 To UBound(Mémo())
    TabDonnées(i) = Left(Mémo(i, 0), 1) & Left(Mémo(i, 1), 1)
Next i
 
' Génère le classement de la clé en ordre croissant:
Classement = QuickSort_AndRank(TabDonnées, True)
 
y = Tableau.Row ' ligne d'origine du tableau.
y = y + 1 ' une ligne suplémentaire pour l'entête.
 
' Mise à jour des données du tableau (lignes et colonnes) d'après leur classement:
For i = 0 To UBound(Classement)
    For x = 0 To (Tableau.Count / UBound(Tableau())) - 1
        Cells(y, Tableau.Column + x) = Mémo(Classement(i), x)
    Next x
    y = y + 1
Next i
 
End Sub
 
 
'-------------------------------------------------------------------------------
Public Function QuickSort_AndRank(ByRef TabDonnées() As Variant, _
                Optional ByVal OrdreCroissant As Boolean = True) As Variant
'-------------------------------------------------------------------------------
Dim i As Long, Mini As Long, Maxi As Long
Dim Anc As Long, Classement As Long
 
Mini = LBound(TabDonnées)
Maxi = UBound(TabDonnées)
ReDim Ref(Mini To Maxi) As Long
Dim Pos() As Long
 
' Initialise les données avant de les trier:
For i = Mini To Maxi: Ref(i) = i: Next i
 
' Trie les données:
If OrdreCroissant = True Then
    Call QS(TabDonnées(), Ref(), Mini, Maxi)
Else
    Call QSDEC(TabDonnées(), Ref(), Mini, Maxi)
End If
 
' Retourne le classement:
' ~~~~~~~~~~~~~~~~~~~~~~~
QuickSort_AndRank = Ref()
 
End Function
 
'-------------------------------------------------------------------------------
Private Sub QS(ByRef TabDonnées() As Variant, ByRef Ref() As Long, _
               ByVal Gauche As Long, ByVal Droite As Long)
'-------------------------------------------------------------------------------
Dim i As Long, j As Long, Temp As Long, ValQS As Variant
 
i = Gauche
j = Droite
ValQS = TabDonnées(Ref((Gauche + Droite) / 2))
 
Do
    While ValQS > TabDonnées(Ref(i)): i = i + 1: Wend
    While ValQS < TabDonnées(Ref(j)): j = j - 1: Wend
 
    If j + 1 > i Then
        Temp = Ref(i)
        Ref(i) = Ref(j)
        Ref(j) = Temp
        j = j - 1: i = i + 1
    End If
 
Loop Until i > j
 
If Gauche < j Then Call QS(TabDonnées(), Ref(), Gauche, j)
If i < Droite Then Call QS(TabDonnées(), Ref(), i, Droite)
 
End Sub
 
'-------------------------------------------------------------------------------
Private Sub QSDEC(ByRef TabDonnées() As Variant, ByRef Ref() As Long, _
                  ByVal Gauche As Long, ByVal Droite As Long)
'-------------------------------------------------------------------------------
Dim i As Long, j As Long, Temp As Long, ValQS As Variant
 
i = Gauche
j = Droite
 
ValQS = TabDonnées(Ref((Gauche + Droite) / 2))
 
Do
    While ValQS < TabDonnées(Ref(i)): i = i + 1: Wend
    While ValQS > TabDonnées(Ref(j)): j = j - 1: Wend
 
    If j + 1 > i Then
        Temp = Ref(i)
        Ref(i) = Ref(j)
        Ref(j) = Temp
        j = j - 1: i = i + 1
    End If
 
Loop Until i > j
 
If Gauche < j Then Call QSDEC(TabDonnées(), Ref(), Gauche, j)
If i < Droite Then Call QSDEC(TabDonnées(), Ref(), i, Droite)
 
End Sub
'-------------------------------------------------------------------------------
'-------------------------------------------------------------------------------

**Pierre Fauconnier** · 21/08/2019, 11h01

Je serais tout de même bien curieux de voir en quoi gêne de mettre une colonne temporaire à droite et de la supprimer après, ceci dit...

**curt** · 21/08/2019, 17h02

Bonsoir Laurent et Pierre,

@laurent : merci pour la démarche tant technique que pédagogique - De plus, mettre un lien vers ta signature et les infos est de toute façon un plus (je vais y regarder de très près)

@pierre : effectivement, je suis d'abord partie sur cette solution facile et efficace (et qui fonctionne actuellement) en masquant la colonne concernée. Mais comme tout ce que l'on veut cacher fini un jour par être découvert, je souhaitai faire le tri sans passer par cette colonne temporaire (on ne détruit pas ce qui n'existe pas)

@ tous : merci à tous les intervenants pour leur aide - je vais regarder les liens proposés et si besoin, je repasserai vous voir.

Curt

**Transitoire** · 21/08/2019, 17h40

Bonsoir, je vais peut-être dire pleins de bêtises?

En ce qui me concerne, j'utiliserais une extraction totale de ma base de données par filtre élaboré sur une autre feuille. Ainsi je pourrais travailler sur ma base de données bis sans la moindre altération de la base de départ.
Cela me permettrais d'effectuer des tri séquentiels en toute sécurité de manière à obtenir un tri très complexe. Car le problème des tri/tri successif est le retour a l'original

Enfin moi ce que j'en dit ??? Je ne détiens pas de vérité.
Cordialement

**Pierre Fauconnier** · 21/08/2019, 18h30

Envoyé par curt

[...]

@pierre : effectivement, je suis d'abord partie sur cette solution facile et efficace (et qui fonctionne actuellement) en masquant la colonne concernée. Mais comme tout ce que l'on veut cacher fini un jour par être découvert, je souhaitai faire le tri sans passer par cette colonne temporaire (on ne détruit pas ce qui n'existe pas)[...]

Tu la crées juste le temps de traiter les données, puis tu la supprimes. C'est juste une colonne temporaire, créée pour le temps du traitement...

Cela dit, la solution de Transitoire est très intéressante aussi. Lorsque je dois traiter ce genre de cas, je travaille toujours sur une copie de la source, ce qui me donne entière liberté pour les traitements...

Associer LEFT et RANGE en VBA [XL-365]

Macros et VBA Excel

Discussions similaires

Partager

Partager