VBA pour incrémenter un numéro sur des congés planning...

[Christian0258]

Bonjour à tout le forum,

Je souhaiterais, à nouveau, votre aide afin d'écrire un code pour incrémenter des CA posés sur un planning annuel en colonne...

voir fichier ...

Je vous remercie, par avance, pour le temps que vous voudrez bien vouloir m'accorder.

Bien à vous,
Christian

 

[Christian0258]

Re : VBA pour incrémenter un numéro sur des congés planning...

Re, le forum, job75,

Merci, job75, pour le boulot.
Dis-moi, sauf erreur de ma part, ça ne semble fonctionner QUE jusqu'à la ligne de l'Agent5 ?

C'est pas faut, pour "Bravo, tu as de la suite dans les idées"...lol

Bien amicalement,
Christian

 

[job75]

Re : VBA pour incrémenter un numéro sur des congés planning...

Re,

Dis-moi, sauf erreur de ma part, ça ne semble fonctionner QUE jusqu'à la ligne de l'Agent5 ?

Si tu as oublié ce qu'il y a dans la feuille "Agents" va voir

Par ailleurs j'ai modifié le post #14 en ajoutant Application.ScreenUpdating = False pour accélérer.

Si l'on copie une ligne sur elle-même toutes les cellules (369) sont étudiées.

La macro s'exécute alors chez moi (Win 7 - Excel 2010) en 2,1 secondes.

A+

 

[job75]

Re : VBA pour incrémenter un numéro sur des congés planning...

Re,

Ceci est nettement mieux :

Option Compare Text 'la casse est ignorée

Private Sub Worksheet_Change(ByVal Target As Range)
Dim F As Worksheet, r As Range, agent$, ca%, rtt%
Dim c As Range, P As Range, t, n1%, n2%, i%
Set F = Feuil15 'à adapter, CodeName de la feuille Agents
Set r = Intersect(Target, Rows("12:" & Rows.Count), Me.UsedRange)
If r Is Nothing Then Exit Sub
Application.ScreenUpdating = False
For Each r In Intersect(r.EntireRow, [C:C]) 'si plusieurs lignes
  agent = Replace(r, "en", "")
  ca = 0: rtt = 0
  Set c = F.Cells.Find(agent & "CA", , xlValues)
  If Not c Is Nothing Then ca = c(, 3)
  Set c = F.Cells.Find(agent & "RTT")
  If Not c Is Nothing Then rtt = c(, 3)
  Set P = Intersect(r.EntireRow, Me.UsedRange)
  t = P 'matrice, plus rapide
  n1 = 0: n2 = 0
  For i = 1 To UBound(t, 2)
    If t(1, i) Like "CA*" Then
      n1 = n1 + 1
      t(1, i) = IIf(n1 > ca, "", "CA" & n1)
    ElseIf t(1, i) Like "RTT*" Then
      n2 = n2 + 1
      t(1, i) = IIf(n2 > rtt, "", "RTT" & n2)
    End If
  Next
  Application.EnableEvents = False: P = t: Application.EnableEvents = True
Next
End Sub

Maintenant le copier-coller d'une ligne sur elle-même est immédiat.

Fichier (2).

A+

 

[job75]

Re : VBA pour incrémenter un numéro sur des congés planning...

Re,

C'est vrai, tu t'es donné la peine de nommer 40 cellules dans la feuille "Agents".

Je n'en avais pas besoin, alors pour te faire plaisir :

Option Compare Text 'la casse est ignorée

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, agent$, ca%, rtt%, P As Range, t, n1%, n2%, i%
Set r = Intersect(Target, Rows("12:" & Rows.Count), Me.UsedRange)
If r Is Nothing Then Exit Sub
Application.ScreenUpdating = False
For Each r In Intersect(r.EntireRow, [C:C]) 'si plusieurs lignes
  agent = Replace(r, "en", "")
  ca = 0: rtt = 0
  If IsNumeric(Evaluate(agent & "CA")) Then ca = Evaluate(agent & "CA")
  If IsNumeric(Evaluate(agent & "RTT")) Then rtt = Evaluate(agent & "RTT")
  Set P = Intersect(r.EntireRow, Me.UsedRange)
  t = P 'matrice, plus rapide
  n1 = 0: n2 = 0
  For i = 1 To UBound(t, 2)
    If t(1, i) Like "CA*" Then
      n1 = n1 + 1
      t(1, i) = IIf(n1 > ca, "", "CA" & n1)
    ElseIf t(1, i) Like "RTT*" Then
      n2 = n2 + 1
      t(1, i) = IIf(n2 > rtt, "", "RTT" & n2)
    End If
  Next
  Application.EnableEvents = False: P = t: Application.EnableEvents = True
Next
End Sub

Edit : je retire la variable F devenue inutile.

Fichier (3).

A+

 

[Christian0258]

Re : VBA pour incrémenter un numéro sur des congés planning...

Re, le forum, job75,

Merci pour cette version3, tu vas dire...mais il n'est pas possible de mettre + de 15 CA, alors que tout les Agents (sauf le premier) ont droit à 25 CA et 15 pour les RTT...

Par ailleurs la saisie de RTT ne semble pas fonctionner.... ?
Je pense que les droits pris en compte dans la feuille Agents, sont inversés, et c'est la raison du blocage des CA à 15... ?


Peux-tu me dire...

Bien à toi,
Christian

 

[JCGL]

Re : VBA pour incrémenter un numéro sur des congés planning...

Bonjour à tous,
Salut Gérard,
Salut Christian,

Bravo, tu as de la suite dans les idées

C'est l'Hôpital qui se moque de l'Infirmerie...

Ne changez rien les amis. Votre persévérance fait plaisir à lire.

A++
A+ à tous

 

[job75]

Re : VBA pour incrémenter un numéro sur des congés planning...

Re, bonjour Jean-Claude

Par ailleurs la saisie de RTT ne semble pas fonctionner.... ?

Oui une coquille sur la ligne du 2ème If IsNumeric, j'avais mis ca = au lieu de rtt =, j'ai corrigé le fichier (3).

A+

 

[Christian0258]

Re : VBA pour incrémenter un numéro sur des congés planning...

Re, le forum, Jean Claude, job75,

Salut Jean-Claude, "Ne changez rien les amis. Votre persévérance fait plaisir à lire.", merci pour le compliment...lol

Merci job75, ça fonctionne parfaitement.
Bien à toi,
Christian