Autres Extraire partie numérique la plus grande...

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Bonjour, à nouveau, à tout le forum.

J'ai cherché, beaucoup...lol, mais je ne trouve pas la solution à mon problème.
J'aurais besoin de vos lumières.

Bien à vous,
Christian
Bonjour,
Modifier le code comme suit :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)  'job75
Dim r As Range, ca, rtt, am, n1, n2, n3
Set r = [g5].Resize(Application.Match("zzz", [g:g]) - 3)
If Intersect(Target, r) Is Nothing Then Exit Sub
ca = [DroitCA]: rtt = [DroitRTT]: am = [DroitAM]
Application.ScreenUpdating = False
Application.EnableEvents = False
For Each r In r
  If r Like "CA*" Then n1 = n1 + 1: r = IIf(n1 > ca, "", "CA" & n1)
  If r Like "RTT*" Then n2 = n2 + 1: r = IIf(n2 > rtt, "", "RTT" & n2)
  If r Like "AM*" Then n3 = n3 + 1: r = IIf(n3 > am, "", "AM" & n3)
Next
[F1] = n1
[F2] = n2
[F3] = n3
Application.EnableEvents = True
End Sub
Cordialement,
 
Bonjour,
Modifier le code comme suit :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)  'job75
Dim r As Range, ca, rtt, am, n1, n2, n3
Set r = [g5].Resize(Application.Match("zzz", [g:g]) - 3)
If Intersect(Target, r) Is Nothing Then Exit Sub
ca = [DroitCA]: rtt = [DroitRTT]: am = [DroitAM]
Application.ScreenUpdating = False
Application.EnableEvents = False
For Each r In r
  If r Like "CA*" Then n1 = n1 + 1: r = IIf(n1 > ca, "", "CA" & n1)
  If r Like "RTT*" Then n2 = n2 + 1: r = IIf(n2 > rtt, "", "RTT" & n2)
  If r Like "AM*" Then n3 = n3 + 1: r = IIf(n3 > am, "", "AM" & n3)
Next
[F1] = n1
[F2] = n2
[F3] = n3
Application.EnableEvents = True
End Sub
Cordialement,
Re, le forum,
Gégé-45550
Merci infiniment, ça fonctionne parfaitement.
Bien à toi
Christian
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
2
Affichages
130
  • Question Question
XL 2019 MFC
Réponses
6
Affichages
182
Retour