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
|
Option Explicit
Public DetectionColonnes As String
Sub TrierLeTableauMdb()
Dim ShMdbBav As Worksheet
Dim TitreMdb As Long, ColLargeurCable As Long
On Error GoTo Fin
Set ShMdbBav = Sheets("MdB BAV MHSA")
With ShMdbBav
TitreMdb = LigneDeTitreTrouvee(ShMdbBav, Array("RepereCable", "RepereCheminCable", "LargeurCheminCable"), 100)
If TitreMdb = 0 Then
MsgBox "La ligne de titre n'a pas été trouvée !", vbCritical
GoTo Fin
End If
DetectionColonnes = "Absence colonnes : " & Chr(10) ' Vérification utile si d'autres colonnes sont à détecter que celles pour LigneDeTitreTrouvee
ColLargeurCable = ColonneFeuille(ShMdbBav, TitreMdb, "LargeurCable")
If DetectionColonnes <> "Absence colonnes : " & Chr(10) Then
MsgBox DetectionColonnes, vbCritical, "Vérification de la présence des colonnes"
GoTo Fin
End If
TrierUnTableau ShMdbBav, TitreMdb, ColLargeurCable, "Croissant"
End With
MsgBox "Fin du tri !", vbInformation
GoTo Fin
Fin:
Set ShMdbBav = Nothing
End Sub
Sub TrierUnTableau(ByVal FeuilleATrier As Worksheet, ByVal LigneDeTitre As Long, ByVal ColonneATrier As Long, ByVal OrdreDuTri As String)
Dim DerniereColonne As Long, DerniereLigne As Long
Dim AireATrier As Range, AireColonne As Range
With FeuilleATrier
DerniereColonne = .Cells(LigneDeTitre, .Columns.Count).End(xlToLeft).Column
DerniereLigne = .Cells(.Rows.Count, ColonneATrier).End(xlUp).Row
If DerniereLigne > LigneDeTitre Then
Set AireATrier = .Range(.Cells(LigneDeTitre, 1), .Cells(DerniereLigne, DerniereColonne))
Set AireColonne = .Range(.Cells(LigneDeTitre, ColonneATrier), .Cells(DerniereLigne, ColonneATrier))
.Sort.SortFields.Clear
If OrdreDuTri = "Croissant" Then
.Sort.SortFields.Add Key:=AireColonne, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
Else
.Sort.SortFields.Add Key:=AireColonne, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
End If
With .Sort
.SetRange AireATrier
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Set AireColonne = Nothing
Set AireATrier = Nothing
End If
End With
End Sub
Function ColonneFeuille(ByVal FeuilleTitre As Worksheet, ByVal LigneTitre As Long, ByVal TitreRecherche As String) As Long
Dim NbColonnes As Long
Dim Cellule As Range
Dim Aire As Range
With FeuilleTitre
ColonneFeuille = 0
NbColonnes = .Cells(LigneTitre, .Columns.Count).End(xlToLeft).Column
Set Aire = .Range(.Cells(LigneTitre, 1), .Cells(LigneTitre, NbColonnes))
For Each Cellule In Aire
Select Case Mid(Cellule.Value, 1, Len(TitreRecherche))
Case TitreRecherche
ColonneFeuille = Cellule.Column
Exit For
End Select
Next
If ColonneFeuille = 0 Then DetectionColonnes = DetectionColonnes & Chr(10) & TitreRecherche
Set Aire = Nothing
End With
End Function
Function LigneDeTitreTrouvee(ByVal FeuilleTestee As Worksheet, ByVal LibellesATester As Variant, ByVal NombreDeLignesTestees As Long) As Long
Dim CompteurDeLignes As Long
Dim CompteurDeColonnes As Long
Dim CompteurDeLibelles As Long
Dim NbChaines As Long
With FeuilleTestee
LigneDeTitreTrouvee = 0
If .UsedRange.Rows.Count > 0 Then
For CompteurDeLignes = .UsedRange.Row To .UsedRange.Row + NombreDeLignesTestees - 1
NbChaines = 0
For CompteurDeLibelles = LBound(LibellesATester) To UBound(LibellesATester)
If WorksheetFunction.CountA(.Rows(CompteurDeLignes)) > 0 Then
For CompteurDeColonnes = .UsedRange.Column To .Columns.Count
If CStr(.Cells(CompteurDeLignes, CompteurDeColonnes)) = LibellesATester(CompteurDeLibelles) Then NbChaines = NbChaines + 1
Next CompteurDeColonnes
End If
Next CompteurDeLibelles
If NbChaines = UBound(LibellesATester) + 1 Then
LigneDeTitreTrouvee = CompteurDeLignes
Exit Function
End If
Next CompteurDeLignes
End If
End With
End Function |
