Ajouter N° en début de cellules

[maval]

Bonjour,

J'ai une feuille ou j'ai environ 600 noms, j'aimerai en VBA lui ajouter un N° à chaque début de cellules

01-
02-
03- ect...

Je vous remercie de votre aide

Cordialement

Max

 

[DoubleZero]

Bonjour, maval, le Forum,

Comme ceci ?

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

Je ne parviens pas à insérer le zér🙁...

A bientôt 🙂

 

[maval]

Bonjour DoubleZero,

Je te remercie
Bonne journée
Max

 

[job75]

Bonjour maval, DoubleZero 🙂

Chère ânesse pour insérer des zéros il suffit de formater le nombre :

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

A+

 

[mapomme]

Bonjour à maval 🙂, DoubleZero 😉, job75 😉,

J'avais commencé comme job75, en automatisant le nombre de zéro et en permettant d'exécuter plusieurs fois la macro et avec un seul nom.

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

 

[job75]

Re, salut mapomme,

Si l'on veut relancer la macro après des ajouts de noms ou un tri :

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

A+

 

[maval]

Bonjour Job75, Mapomme,

Je vous remercie beaucoup Nickel

Je vous souhaite un bon Dimanche

Max

 

[job75]

Re,

Ce n'est pas fini, si l'on veut que les noms soient toujours classés alphabétiquement :

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

Le tri intermédiaire est réalisé par la macro bien connue Quick sort.

Fichier joint.

A+

 

[libellule85]

Bonsoir vous tous,
On reconnait bien là Job75 pour les améliorations apportées aux macros.

 

[job75]

Bonjour libellule85 🙂 le forum,

S'il s'agit d'un tableau de plusieurs colonnes adapter Quick sort :

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

Fichier (2).

Bonne journée.

 

[maval]

Bonjour Job75

Je te remercie vraiment sympa

Bonne soirée

max