Reclassement des cotes Dewey

Cette macro permet de reclasser les cotes Dewey dans les fichiers de récolement issus de Loris.

Avant l'application de la macro : classement alphabétique

456 GAR
456.1 GAR
456.156 4 GAR
456.156 GAR

Après l'application de la macro : classement numérique dans la colonne des indices

456GAR
456.1GAR
456.156GAR
456.156 4GAR
Public max As Integer
Sub Cotes()
Application.ScreenUpdating = False
InserColonne
NombreLignes
DernierChiffre
Trier
Application.ScreenUpdating = True
End Sub

Sub InserColonne()
Columns("B:B").Select
Selection.Insert Shift:=xlToLeft
End Sub

Sub NombreLignes()
Range("A1").Select
Selection.End(xlDown).Select
max = Selection.Row
End Sub

Sub DernierChiffre()
Dim cote As String
Dim aCouper As String
Dim aGarder As String
Dim longueur As Integer
Dim caractere As String
Dim m, n, p As Integer
Dim chiffres As Variant
chiffres = Array("0", "1", "2", "3", "4", "5", "6", "7", "8", "9")
For p = 1 To max
    Dim plage As String
    plage = "A" & p
    Range(plage).Select
    cote = ActiveCell.Value
    longueur = Len(cote)
    For m = longueur To 1 Step -1
        caractere = Mid(cote, m, 1)
        For n = 0 To 9
           If StrComp(caractere, chiffres(n), 1) = 0 Then
           aCouper = Mid(cote, m + 1, (longueur - m) + 1)
           aGarder = Mid(cote, 1, m)
           n = 9
           m = 0
           End If
       Next
    Next
Selection.Offset(0, 1).Value = LTrim(aCouper)
Selection.NumberFormat = "@"
Selection.Value = aGarder
Next
End Sub
Sub Trier()
Cells.Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Key2:=Range("B1"),Order2:=xlAscending
Range("A1").Select
End Sub

Attention : cette macro suppose que les cotes sont dans la colonne A !!