XL 2013 Comptabiliser des durées à partir de cellulles "1/4h"

Schmoute · 12 Juin 2017

Bonjour à tous,

J'ai longtemps été dépanné sur des petits problèmes sur ce forum, mais j'arrive ce jour avec une question qui, si elle est résolue, m'évitera de passer trop de temps sur mon fichier.

C'est un souci de planning, j'ai plusieurs collaborateurs pour lesquels j'ai besoin de savoir leur quotité horaire journalière, sauf que leur planning est représenté par des cellules colorées de 15 minutes en minutes. Je cherche à avoir un résultat du type 4 cellules colorées de 8h00 à 09h00 = 1 heures de quotité horaire.

Je joins à ma question le fichier en question.

D'avance, un immense merci au contributeur qui se penchera sur la question.

Je suite à l'écoute de tous pour une question éventuelle sur mon problème.

PS : je suis une buse totale en VBA, et je crois bien que le problème se résoudra ainsi.

Schmoute · 13 Juin 2017

Ok ca marche, merci !
La piste peut-être la prise en compte d'une ou deux suite de cellules colorées.......

vgendron · 13 Juin 2017

en fait, j'ai eu le temps de faire ceci..
à tester

VB:

Public Function Quotité()
Application.Volatile

ligne = Parent.Caller.Row 'récupère le numéro de ligne où est inscrite la formule

Set zone = Range("B" & ligne & ":BA" & ligne) 'récupère la zone colonne B à BA
PauseMidi = False 'permet de dectecter une pause midi
DemiJournée2 = False 'permet de dectecter une après midi
NbQuart = 0 'initialise le nombre de quart d'heure
For Each quart In zone
       
    If quart.Interior.Color = 255 And PauseMidi = False Then 'on est AVANT la pause du midi
        If quart.Offset(0, 1).Interior.Color <> 255 Then PauseMidi = True
    End If
   
    If quart.Interior.Color <> 255 And PauseMidi = True Then 'on est dans la pause
        If quart.Offset(0, 1).Interior.Color = 255 Then DemiJournée2 = True
    End If
   
    If quart.Interior.Color = 255 Then 'si le quart d'heure est coloré en ROUGE
        NbQuart = NbQuart + 1
    End If
Next quart
If PauseMidi = True Then NbQuart = NbQuart - 1
If DemiJournée2 = True Then NbQuart = NbQuart - 1

NbHeure = Int(NbQuart / 4) 'calcul du nombre d'heure
NbMinute = (NbQuart - NbHeure * 4) * 15 'calcul du nombre de minutes
Quotité = Format(TimeValue("" & NbHeure & ":" & NbMinute & ":00"), "hh:mm") 'on retourne le résultat au format heure
End Function

Modeste geedee · 13 Juin 2017

bonsour®

Schmoute à dit:
Bonjour,

La nuit est passée, et j'ai pas bien compris...
A fait 8h30-12h30 / 13h30-18h45, soit 9h15 qui sont bien calculés dans le fichier.
M et N font respectivement 8h45-12h30 et 8h15-10h00 soit 3h45 et 1h45 or le fichier me zappe 1/4 d'heure.
Quelque chose peut régler ce problème sans forcément changer l'aspect de mon fichier et interprétation des créneaux horaires ?

en comptant les "X", c'est BEAUCOUP plus simple..

Vgendron à dit:
les heures indiquées dans ta feuille doivent etre considérées comme le Debut d'un quart d'heure travaillé.
et UNIQUEMENT un début;
donc. si tu travailles de 08h à 12h.. tu dois colorer 08h / :15 / :30 / et :45 ce qui te fais 4 cases

Schmoute · 13 Juin 2017

@vgendron : ton code fonctionne, merci à toi !!!

@Modeste : salut ! merci pour ta collaboration, en fait, ce qui me gênait, c'était le "X", ainsi que la dernière case non colorée par rapport au 1/4 d'heure commencé... Cela pouvait induire des quiproquo dans ce que j'essaye de présenter...

Modeste geedee · 13 Juin 2017

Bonsour®

Schmoute à dit:
@Modeste : salut ! merci pour ta collaboration, en fait, ce qui me gênait, c'était le "X", ainsi que la dernière case non colorée par rapport au 1/4 d'heure commencé... Cela pouvait induire des quiproquo dans ce que j'essaye de présenter...

- sans code ça fonctionne aussi !!!

quel quiproquo ??? : avec ou sans code, un 1/4 d'heure non commencé n'a pas à être colorisé !

- le "x" peut être masqué par une MEFC (format ";;;")
- le "x" peut être remplacé par "f" Formation, "r" Réunion et MEFC adaptée sans intervention dans un code quelconque

XL 2013 Comptabiliser des durées à partir de cellulles "1/4h"

Schmoute

XLDnaute Nouveau

Pièces jointes

Schmoute

XLDnaute Nouveau

vgendron

XLDnaute Barbatruc

Modeste geedee

XLDnaute Barbatruc

Pièces jointes

Schmoute

XLDnaute Nouveau

Modeste geedee

XLDnaute Barbatruc

Discussions similaires