XL 2016 Compter Nombre jour Travailé et surligné si superieur à 5

[Eric_Clamart]

Bonjour
J'ai tableau qui récupére les plannings des employées sur l'année. J'aimerai pouvoir, sur ce tableau, compter tous les jours travaillés consécutif, "JT", et si supérieur à 5 jours, que la plage soit surlignée.
Je n'arrive pas a trouver un code VBA pour cela étant un peu novice .....
En vous remerciant pour votre aide.

 

[Monptipiton]

Bonjour,

- Déclarer les variables : i as long, etc
- Créer un array : dim Tablo()
- Désactiver le rafraichissement d'écran : application.screenupdating
- Transférer la plage dans l'array : tablo = range(...)
- Boucler sur l'array et mettre en place un compteur et une condition pour surligner les cellules concernées
- Réactiver le rafraîchissement d'écran
- Libérer la mémoire : erase tablo

Avec ça tu devrais t'en sortir et pouvoir faire ton job

@+

 

[fanfan38]

Bonjour
Ci joint ma solution par macro
A+ François

 

[Eric_Clamart]

Bonjour
Merci pour votre réponse qui répond presque à mes besoins.
Les plus de 5 jours travaillés sont bien surlignés quand ils sont sur la même ligne mais fin octobre début novembre par exemple, la personne a travaillé 8 jours de suite mais ils ne sont pas surlignés en rouge.
De plus ayant 40 employés, est il possible de faire appel à un dialog box pour déterminer la range ?
Merci encore

 

[fanfan38]

Bonsoir
Le problème est réglé...
Pour les 40 employés je présume que ça c'est la feuille d'un employé?
il faut choisir la feuille en fonction du choix de l'employé?
A+ François

 

[Eric_Clamart]

Bonsoir

super ça marche bien
Pour les employés, ils sont les un en dessous des autres
Voir ci joint.
Peut être la macro peut prendre en compte toute la feuille d'un seul coup ?

 

[fanfan38]

Tu as raison la macro peux prendre toute la feuille...
A ajouter en debut de macro (apres le sub
Application.ScreenUpdating = False
et en fin de macro avant le end sub
Application.ScreenUpdating = true

A+ François

 

[Eric_Clamart]

Bonsoir
Je n'est tout compris à la macro mais elle marche super bien, c'est génial
Merci beaucoup

 

[fanfan38]

Private Sub CommandButton1_Click() 'contrôle
 Application.ScreenUpdating = False 'gain de temps pas d'affichage
 'declaration des variables'
  Dim i As Long, col As Integer, nb As Byte, j As Integer, derlig As Long
  'initialisation de la variable nombre'
   nb = 0
   'recherche de la dernière ligne de la feuille'
   derlig = Range("A" & Rows.Count).End(xlUp).Row
   'boucle de la ligne 4 à la dernière ligne'
   For i = 4 To derlig
   'si la cellule de la 1ère colonne n'est pas vide
    If Len(Range("A" & i).Value) > 0 Then
    'boucle de la colonne 2 à 32'
     For col = 2 To 32
     'si la cellule est = à JT
      If Cells(i, col).Value = "JT" Then
        nb = nb + 1 'nombre =nombre +1
        'colorie la cellule en jaune
        Cells(i, col).Interior.ColorIndex = 6
      Else 'sinon'
       nb = 0 'reinitialise le nombre
       'colorie les cellules en fonction de leur contenu
       Select Case UCase(Cells(i, col).Value)
         Case Is = "JRS"
          Cells(i, col).Interior.ColorIndex = 17
         Case Is = "CP"
          Cells(i, col).Interior.ColorIndex = 4
         Case Is = "EF"
          Cells(i, col).Interior.ColorIndex = 8
         Case Is = "DEP"
          Cells(i, col).Interior.ColorIndex = 7
         Case Is = "CFA"
          Cells(i, col).Interior.ColorIndex = 22
         Case Is = "N/A" 'efface les cellules contenant N/A'
          Cells(i, col).ClearContents
       End Select
      End If
      If nb > 5 Then 'si nombre >5'
       If col + 1 - nb > 2 Then 'si c'est sur la même ligne
        Range(Cells(i, col + 1 - nb), Cells(i, col)).Interior.ColorIndex = 3
       Else 'sinon recherche de la dernière cellule de la ligne précédente'
        j = 32
        While Cells(i - 1, j).Value <> "JT"
                  j = j - 1
        Wend 'colorie la ligne précédente'
        Range(Cells(i - 1, j - nb + col), Cells(i - 1, j)).Interior.ColorIndex = 3
        'et la ligne suivante'
        Range(Cells(i, 2), Cells(i, col)).Interior.ColorIndex = 3
       End If
      End If
     Next
    Else
      nb = 0
    End If
   Next
    Application.ScreenUpdating = True 'remet l'affichage

A+ François

 

[Eric_Clamart]

Bonsoir
Merci pour toutes ces explications, essayant d'apprendre en pratiquant, je comprends mieux avec le détails
je vous remercie beaucoup

 

[Eric_Clamart]

Maintenant, si la personne travail plus de 5 jours , les cellules sont bien surlignées. Si nous corrigeons, une des cellule reste surlignée ?