Comment effectuer un tri alphabetique avec une macro

**alexistak** · 14/02/2008, 13h42

Bonjour
j'ai une macro ci joint qui me fait un report a partir d'une liste.
La macro regarde les noms de la colonne B.
Qunad deux noms se suivent elle efface le deuxieme et laisse le premier.
Ensuite elle colore les lignes correspondant au nom et separe ces plages de couleurs avec un trait.
J'aimerais connaitre si vous avez une fonction qui fait du tri alphabetique en fonction de cette colonne.
Ci joint le code,

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
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
Sub Main1()
 
'***Variables***
Dim GCCReport As Workbook                               'Workbook of report from GCC
Dim row_count As Integer                                'Counter for no of rows in GCC Report
 
'opens dialog box to choose report
Filename = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls), *.xls", Title:="Please select a file")
    If Filename = False Then
        ' They pressed Cancel
        MsgBox "Stopping because you did not select a file"
        Exit Sub
    Else
        Workbooks.Open (Filename)
    End If
 
 
    row_count = RowCount
 
    With ActiveWorkbook.Worksheets("Sheet1")
        'adjust column width
        .Columns("A").ColumnWidth = 10
        .Columns("B").ColumnWidth = 10
        .Columns("C").ColumnWidth = 10
        .Columns("D").ColumnWidth = 10
        .Columns("E").ColumnWidth = 10
        .Columns("F").ColumnWidth = 5
        .Columns("G").ColumnWidth = 5
        .Columns("H").ColumnWidth = 5
        .Columns("I").ColumnWidth = 8
        .Columns("L").ColumnWidth = 25
        .Columns("M").ColumnWidth = 8
        .Columns("N").ColumnWidth = 25
        .Columns("O").ColumnWidth = 20
        .Columns("P").ColumnWidth = 7
 
 
        'adjust row heigth
        .Rows("4:20000").AutoFit
 
        'Set Borders for Cells
        .Range(Worksheets("Sheet1").Cells(4, 1), Worksheets("Sheet1").Cells(row_count, 17)).Borders.Weight = xlHairline
        .Range(Worksheets("Sheet1").Cells(4, 1), Worksheets("Sheet1").Cells(row_count, 17)).Borders.Color = RGB(0, 0, 0)
        .Range(Worksheets("Sheet1").Cells(4, 1), Worksheets("Sheet1").Cells(row_count, 17)).Borders.LineStyle = xlContinuous
        .Range("A3:Q3").Borders.LineStyle = xlContinuous
        .Range("A3:Q3").Borders.Weight = xlHairline
        .Range("A3:Q3").Borders.Color = RGB(0, 0, 0)
 
       End With
 
 
Call ColorUPC(5, row_count, 14)
Call SeperateUPC(5, row_count, 14)
Call PrintSetup(65, 2)
'Call Rangement(1)
End Sub
 
 
 
 
'~~~~~~~~~~~~~~~~~Function to count rows in GCCReports~~~~~~~~~~~~~~~~~
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Function RowCount() As Integer
 
Dim m As Integer            'Loop Counter
m = 5
 
Do While (ActiveWorkbook.Worksheets("Sheet1").Cells(m, 2).Value <> 0)
 
m = m + 1
Loop
 
RowCount = m - 1
 
End Function
 
'~~~~~~~~~~~~~~~~~~~Sub to color UPCs in order to separate them~~~~~~~~~~~~~~~~~~~
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'Arguments~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'start_row              specifies where to start the separation of UPCs
'row_max                row in which to end sub
'col_max                column until which background color should be changed
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'uses UPC as reference to sort
 
 
Sub ColorUPC(start_row As Integer, row_max As Integer, col_max As Integer, Optional comp_row As Integer = 2)
 
Dim i As Integer
i = start_row
marker = 0
'MsgBox row_max
 
Do While (i <= row_max)
 
If Worksheets("Sheet1").Cells(i, comp_row + 1) <> Worksheets("Sheet1").Cells(i - 1, comp_row + 1) Then
 
    With Worksheets("Sheet1").Range(Worksheets("Sheet1").Cells(i, 1), Worksheets("Sheet1").Cells(i, col_max)).Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .Color = RGB(0, 0, 0)
    End With
 
    marker = marker + 1
    'MsgBox "Marker  " & marker & " Loop counter  " & i
End If
 
If (marker Mod 2 = 0) Then
    Worksheets("Sheet1").Range(Worksheets("Sheet1").Cells(i, 1), Worksheets("Sheet1").Cells(i, col_max)).Interior.Color = RGB(255, 228, 181)
End If
 
 
i = i + 1
Loop
 
End Sub
 
Sub PrintSetup(resize As Double, sheet As Integer)
 
Dim Run As Boolean
 
Run = Application.Dialogs(xlDialogPrinterSetup).Show
 
If Run = False Then
MsgBox "Stopping Print Setup since no printer was chosen"
Exit Sub
Else
    '************Page Setup***************
    With Workbooks("GCC Violation Report Filter Macro.xls").Worksheets(sheet).PageSetup
        '.PaperSize = xlPaperA3
        .Zoom = resize
        .Orientation = xlLandscape
        .TopMargin = 0.5
        .BottomMargin = 0.5
        .RightMargin = 0.5
        .LeftMargin = 0.5
        '.PrintArea = "A1:AR10"
    End With
 
Application.Dialogs(xlDialogPrintPreview).Show
End If
'    '************Print Dialog***********
'    ActiveWorkbook.Worksheets(1).PrintOut
 
End Sub
 
'uses UPC as reference to sort
 
Sub SeperateUPC(start_row As Integer, row_max As Integer, col_max As Integer, Optional comp_row As Integer = 2, Optional del As Boolean = True)
 
Dim i As Integer
i = start_row
before = Worksheets("Sheet1").Cells(i - 1, comp_row)
 
Do While (i <= row_max)
 
    If Worksheets("Sheet1").Cells(i, comp_row) = before Then
 
    before = Worksheets("Sheet1").Cells(i, comp_row)
 
    If del = True Then
    Worksheets("Sheet1").Cells(i, comp_row).ClearContents
    End If
 
    Worksheets("Sheet1").Cells(i, comp_row).ClearContents
 
 
 
    Else
 
    before = Worksheets("Sheet1").Cells(i, comp_row)
 
    End If
 
    i = i + 1
 
Loop
 
End Sub
'*******************'
'''''''''TEST j AI ESSAYE CA MAIS CA COMPILE PAS COMME JE VEUX
'Sub Rangement(Selection_sort) ' Triage de la feuille "Sheet1" par ordre croissant sur la première colonne
 
 
    'Worksheets("Sheet1").Range("A1:P500").Select   ' Sélection de toute la zone de données pour le tri
'    Selection_sort Key1 = Range("B5")
'    Order1 = xlAscending
'    Header = xlGuess
'    OrderCustom = 1
'    MatchCase = False
'        Orientation = xlTopToBottom ' Instructions de tri
'    Range("B5").Select                                                ' Selection A1'
'Worksheets("Sheet1").Select                                                ' Selection feuille de travail
'End Sub

Je ne suis pas tres bon en code, si vous avez une fonction de tri merci de me preciser comment l'appeler la declarer etc...

Merci de votre aide

**Pierre Fauconnier** · 14/02/2008, 14h21

Bonjour

Tu as à ta disposition la méthode Sort d'un objet Range, qui correspond à la boite de dialogue Données/Trier...

Exemple, pour le tri de la plage A1:E100 sur la deuxième colonne en tri croissant avec entêtes de colonnes

Code :

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

Range("a1:E100").Sort key1:=Range("b1"), Order1:=xlAscending, header:=xlYes

Ok?

**alexistak** · 14/02/2008, 14h34

J'ai essaye de la mettre dans le code mais faut creer un sub?
tu peux me montrer en faisant un copier coller de mon code eavec la fonction dedans.
Merci

**Pierre Fauconnier** · 14/02/2008, 14h52

Non, je ne sais pas te le montrer car je ne sais pas à quel endroit de ton code tu souhaites réaliser le tri.

Mais il ne faut pas créer de sub, il suffit de copier la ligne que je t'ai donnée, et d'adapter les plages... Normalement, rien de bien compliqué...

**alexistak** · 14/02/2008, 15h16

Je viens de faire ce que tu m'a dis, je l'ai mis la:

Code :

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

1
2
3
4
5
6
7
8
9
 
'Set Borders for Cells
        .Range(Worksheets("Sheet1").Cells(4, 1), Worksheets("Sheet1").Cells(row_count, 17)).Borders.Weight = xlHairline
        .Range(Worksheets("Sheet1").Cells(4, 1), Worksheets("Sheet1").Cells(row_count, 17)).Borders.Color = RGB(0, 0, 0)
        .Range(Worksheets("Sheet1").Cells(4, 1), Worksheets("Sheet1").Cells(row_count, 17)).Borders.LineStyle = xlContinuous
        .Range("A3:Q3").Borders.LineStyle = xlContinuous
        .Range("A3:Q3").Borders.Weight = xlHairline
        .Range("A3:Q3").Borders.Color = RGB(0, 0, 0)
        .Range("A5:P1000").Sort key1:=Range("B5"), Order1:=xlAscending, header:=xlYes

Le compilateur m'imsulte et la liste n'est pas triee

Je pense qu'il faudrait faire le tri au tout debut. Mais je vois pas pourquoi il me met en mode debbug???

**Pierre Fauconnier** · 14/02/2008, 15h36

Au sein d'un bloc With... End With, tu dois préciser le parent de la cellule qui sert de base au tri en la faisant précéder d'un point

Code :

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

.Range("A5:P1000").Sort key1:=.Range("B5"), Order1:=xlAscending, header:=xlYes

Puisque ta macro supprime les lignes lorsque la valeur d'une cellule est identique à celle de la cellule située au dessus, il faut en effet que tes lignes soient triées sur la colonne que tu testes => donc, la ligne de tri doit se trouver avant le test de doublons.

**alexistak** · 14/02/2008, 16h22

J'ai du mal, je comprend pas...
J 'ai mis ta ligne de code au debut avec les lignes qui me calibrent la largeur des colonnes.
Mais il m'affiche en jaune la ligne de code qui fait le tri!

**Pierre Fauconnier** · 14/02/2008, 17h16

Quel est le message d'erreur?

De plus, dans ton code (cela n'a a priori rien à voir avec le problème posé), dans les lignes telles que celle-ci

.Range(Worksheets("Sheet1").Cells(4, 1), Worksheets("Sheet1").Cells(row_count, 17)).Borders.Weight = xlHairline

il faut changer les worksheets("Sheet1") par des ., sinon, lorsque tu vas boucler, ça va m***

**alexistak** · 14/02/2008, 17h46

Le salaud....
Je viens de corriger ce que tu m'as dit.
Il me dit que ca marche pas parceque j'ai des cellules fusionnees.
Y a moyen d'eviter ca ou pas?
J'avais essaye " a la main" de trier avec la fonction AZ mais ca me mettait ce msg d'erreur....

Si tu connais un moyen d'ecrire une ligne pour "défusionner" les colonnes qui font c...
c les trois derniere c pas grave si elle dont splite (c du commentaire)

**ouskel'n'or** · 14/02/2008, 17h54

Quand tu ne connais pas le code pour effectuer un instruction, enregistre une macro en faisant. Après, tu simplifies.

**alexistak** · 14/02/2008, 18h03

?
Desole j'ai rien compris

**Many31** · 14/02/2008, 18h21

Envoyé par alexistak

?
Desole j'ai rien compris

le meussieur essaye de t'expliquer que débuter en VbA excell n'est pas si compliqué puisque très intuitif....

pour se faire un clique droit dans la barre des boite a outil et tu rajoute "Visual Basic"
tu viens de rajouter 6 nouvelles commandes.

la premiere un titi triangle sert a lancer manuellement une macro... osef
la seconde beaucoup plus interessante sert a Enregistrer une macro

la troisieme sécurité..... osef aussi
la quatrieme VBA Editor te permet te rentrer directement dans ton code
les deux derniers... ce sont des boites a outils etc.

brefff ce qui t'interesse cest la deuxieme commande

Elle te permet comme dit precedemment d'enregistrer une macro... c'est a dire qu'Excell enregistre TOUT ce que tu fais, le moindre clique, la moindre action que tu fais (bon c'est pas magique, le champs d'action est limité mais pour un débutant c'est largement suffisant.)

Une fois l'enregistrement terminé (quand tu aura cliqué sur le carré qui apparait lors de l'enregistremnt....) tu n'auras plus qu'a aller voir dans le code la macro générée par Excel et t'inspirer de ca pour faire ta propre macro

Par exemple pour ta question tu aurais pu lancer l'enregistrement, faire un tri automatique sur une selection de cellule et après allé voir dans le code pour adapter a ta demande.

veula CQFD

**alexistak** · 14/02/2008, 18h24

Tu es mon hero!
Je connaissais pas cette methode, je galere depuis une semaine avec des vieilles macro, en bidouillant le code presque ligne par ligne.
Merci Merci

PS je sais je suis un gros boulet

**Many31** · 14/02/2008, 18h32

si tu galère tu auras besoin de ca:

en appuyant sur la touche F5 tu peux éxécuter la macro dans laquelle ton curseur se trouve, depuis le code, sans interruption (sauf si ca bugg ^^)

en appuyant sur la touche F8 tu lance l'éxécution en "pas à pas" ==> en gros tu éxécute ligne par ligne... ca aide vachement pour débugger une macro

après tu as le raccourci clavier: CTRL + SPACE ou CTRL + J qui te permet d'afficher des propositions de mot/commande proposé par le VBA excel

exemple si tu commence a tapper

Ap

et que tu appuis sur Controle et Espace il te propose une liste de mot

Excel est bourré de tite astuces

c'est bien pour ca que ce forum existe

Le Héros cest ouskel'nor

Comment effectuer un tri alphabetique avec une macro

Macros et VBA Excel

Discussions similaires

Partager

Partager