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

Eric_Clamart

XLDnaute Nouveau
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.
 

Fichiers joints

Monptipiton

XLDnaute Nouveau
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

@+
 

Eric_Clamart

XLDnaute Nouveau
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

XLDnaute Accro
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
 

Fichiers joints

fanfan38

XLDnaute Accro
VB:
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

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

Eric_Clamart

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

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas