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 |
Partager