Option Explicit
Sub Numéroter()
Dim c As Range
With Application: .ScreenUpdating = False: .Calculation = xlManual: .EnableEvents = False: End With
For Each c In Range(Range("a6"), Range("a6").End(xlDown))
c = c.Row - 5 & "-" & c
Next
With Application: .EnableEvents = True: .Calculation = xlAutomatic: .ScreenUpdating = True: End With
End Sub
Sub Numeroter()
Dim t, i&, n&
With [A6:A999] 'plage à adapter, au moins 2 cellules...
t = .Value
For i = 1 To UBound(t)
If t(i, 1) <> "" Then
n = n + 1
t(i, 1) = Format(n, "000-") & t(i, 1)
End If
Next
.Value = t
End With
End Sub
Sub Numeroter()
Dim n&, t, forma, k&
n = Cells(Rows.Count, "a").End(xlUp).Row
If n >= 6 Then
t = Range("a6:a" & n + 1)
n = Len("" & UBound(t) - LBound(t))
forma = String(n, "0") & "-"
For n = 1 To UBound(t) - 1
k = InStr(t(n, 1), "-")
If k > 0 Then If Val(Left(t(n, 1), k - 1)) > 0 Then t(n, 1) = Mid(t(n, 1), k + 1)
t(n, 1) = Format(n, forma) & t(n, 1)
Next n
Range("a6").Resize(UBound(t) - 1) = t
End If
End Sub
Sub Numeroter()
Dim t, i&, n&
With [A6:A999] 'plage à adapter, au moins 2 cellules
t = .Value
For i = 1 To UBound(t)
If t(i, 1) <> "" Then
n = n + 1
If t(i, 1) Like "###-*" Then t(i, 1) = Mid(t(i, 1), 5)
t(i, 1) = Format(n, "000-") & t(i, 1)
End If
Next
.Value = t
End With
End Sub
Option Compare Text 'la casse est ignorée
Private Sub Worksheet_Change(ByVal Target As Range)
Dim t, i&
With [A6:A999] 'plage à adapter, au moins 2 cellules
t = .Value
For i = 1 To UBound(t)
If t(i, 1) = "" Then t(i, 1) = "zzzzz"
If t(i, 1) Like "###-*" Then t(i, 1) = Mid(t(i, 1), 5)
Next
t = Application.Transpose(t)
tri t, 1, UBound(t)
t = Application.Transpose(t)
For i = 1 To UBound(t)
If t(i, 1) <> "zzzzz" Then t(i, 1) = Format(i, "000-") & t(i, 1) Else t(i, 1) = ""
Next
Application.EnableEvents = False
.Value = t
Application.EnableEvents = True
End With
End Sub
Sub tri(a, gauc, droi) ' Quick sort
Dim ref, g, d, temp
ref = a((gauc + droi) \ 2)
g = gauc: d = droi
Do
Do While a(g) < ref: g = g + 1: Loop
Do While ref < a(d): d = d - 1: Loop
If g <= d Then
temp = a(g): a(g) = a(d): a(d) = temp
g = g + 1: d = d - 1
End If
Loop While g <= d
If g < droi Then Call tri(a, g, droi)
If gauc < d Then Call tri(a, gauc, d)
End Sub
Option Compare Text 'la casse est ignorée
Private Sub Worksheet_Change(ByVal Target As Range)
Dim t, ncol%, i&
With [A6:D999] 'plage à adapter, au moins 2 cellules
t = .Value
ncol = UBound(t, 2)
For i = 1 To UBound(t)
If t(i, 1) = "" Then t(i, 1) = "zzzzz"
If t(i, 1) Like "###-*" Then t(i, 1) = Mid(t(i, 1), 5)
Next
tri t, 1, UBound(t), ncol
For i = 1 To UBound(t)
If t(i, 1) <> "zzzzz" Then t(i, 1) = Format(i, "000-") & t(i, 1) Else t(i, 1) = ""
Next
Application.EnableEvents = False
.Value = t
Application.EnableEvents = True
End With
End Sub
Sub tri(a, gauc, droi, ncol) ' Quick sort
Dim ref, g, d, temp, col
ref = a((gauc + droi) \ 2, 1)
g = gauc: d = droi
Do
Do While a(g, 1) < ref: g = g + 1: Loop
Do While ref < a(d, 1): d = d - 1: Loop
If g <= d Then
For col = 1 To ncol
temp = a(g, col): a(g, col) = a(d, col): a(d, col) = temp
Next
g = g + 1: d = d - 1
End If
Loop While g <= d
If g < droi Then Call tri(a, g, droi, ncol)
If gauc < d Then Call tri(a, gauc, d, ncol)
End Sub