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

Christian0258 à dit:

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

Cliquez pour agrandir...

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

Gégé-45550 à dit:

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,

Cliquez pour agrandir...