Remplissage automatique incrémenté

[Risleure]

Bonjour Le Forum,

Je n'ai pas trouvé dans les archives (probablement pas le bon choix des mots clefs) donc je poste mais je pense que la réponse existe.
Voila quand on rempli une colonne, XL propose de compléter automatiquement la cellule dès qu'il n'y a plus de confusion possible. Par exemple si on a déja Toto, Titi, Tata et que l'on entre To, la proposition d'XL est Toto.

Mais avec les n° de mon chèquier, il faut entrer le n° complet car XL hésite jusqu'au bout 🙁
Dans le petit tableau de comptabilité en PJ, les n° des chèques émis ou reçus sont toujours entrés sous la forme de deux lettres + n chiffres (n= 6 à 10).
Je souhaite avoir la réponse en VBA et non pas par formules 😉
Dans une colonne, la 4 en l'occurence, je dois rentrer des n° des chèques. Si le n° commence par autre chose que CM, rien ne se passe mais si le n° commence par CM, je souhaite qu'XL me propose le CMXXXXXX qui se trouve dans la colonne 4 augmenté de 1 unité et ce n'est pas automatiquement le dernier CMXXXXXX, c'est celui avec le plus grand XXXXXX qui doit être augmenté de 1 unité (j'ai un tri sur le pointage !!). Voir l'exemple en PJ

Merci d'avance

 

[job75]

Re : Remplissage automatique incrémenté

Bonjour Risleure,

Voici une macro qui se lance quand on entre en colonne D un texte de 2 lettres (majuscules ou minuscules) :

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [D:D]) Is Nothing Or Target.Count > 1 Then Exit Sub
If Len(Target) <> 2 Then Exit Sub
Dim n As Double
For Each cel In Range([D2], [D65536].End(xlUp))
If Ucase(Left(cel, 2)) = UCase(Target) Then n = Application.Max(n, Val(Mid(cel, 3, 10)))
Next
If n Then Target = UCase(Target) & n + 1
End Sub

A placer dans le code de la feuille.

A+

 

[Risleure]

Re : Remplissage automatique incrémenté

Merci Job75

Ca marche .........et je ne comprends pas (encore) pourquoi .... et quelque soit les 2 lettres en plus !!!

Merci encore

 

[job75]

Re : Remplissage automatique incrémenté

Re,

Peut-être préférez-vous cela :

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [D:D]) Is Nothing Or Target.Count > 1 Then Exit Sub
If Len(Target) <> 2 Then Exit Sub
Dim n As Double
For Each cel In Range([D2], [D65536].End(xlUp))
If UCase(Left(cel, 2)) = UCase(Target) Then n = Application.Max(n, Val(Mid(cel, 3, 10)))
Next
If n Then Target = UCase(Target) & n + 1
[COLOR="Red"]Target.Select
SendKeys "{F2}"[/COLOR]
End Sub

A+