Calcul du nombre max de jour consécutifs
Bonjour à tous,
afin d'aider un membre je bûche sur un problème, je viens donc à l'aide....
dans le principe, la base initiale est une liste des absences-arrêts maladie ..... pour les employés.
dans la demande on demande de déterminer le nombre de jours max consécutifs non travaillé pour chaque employé... et cela en excluant les jours ou l'entreprise est fermée => les samedi et dimanche...
j'ai essayé de faire un code en utilisant les filtres élaborés, puis boucle de comptage mais je ne m'en sort pas.....
si quelqu'un a une idée
dans le fichier exemple ci joint j'ai fait fait un exemple manuellement pour vous puissiez comprendre....
Merci
Fred
Bonjour,
par formules ? Ca risque d'etre chaud...
Si l'arret démarre un AM ou fini un matin, tu comptes 0.5 en plus ?
Peut-on trier comme on veut ?
En fait c'est facile. Comme ils sont absents alternativement soir et matin 1 jour sur 2, ça fait max 1/2 journée pour tout le monde. Et sans calculette stp !
eric
SAlut Eriic
non par formule je sais que c'est chaud... donc non plus facilement par VBA je penses, ce que j'ai commencé a faire... mais sans succès
a priori non on compte une journée par date inscrite dans la colonne D on ne compte pas de demi journées (je ne sais pas pourquoi... je vais voir si je peux obtenir plus d'infos la dessus...)
A priori tu peux faire ce que tu veux comme tri
merci
Fred
edit : c'est peut-être toi qui a raison, et qu'il faut compter comme cela.... mais ca veux dire que la demande initiale est mal formulée alors
ok, mais il faudrait savoir si chaque date apparait systématiquement 2 fois, ce qui n'est pas le cas dans l'exemple fourni.
Voici la phrase de la demande initiale :
afficher le nombre de jours maximum d'absence continu (sans tenir compte des week-end et jours fériés).
je vais à la pêche aux infos et dès que j'ai une réponse je reviens.... (certainement demain)...
Merci
Fred
Bonsoir à tous,
Une première approche :
Restitution en Feuil2
Option Explicit
Sub test()
Dim a, w(), i As Long, n As Long, dico As Object
Set dico = CreateObject("Scripting.Dictionary")
dico.CompareMode = 1
a = Sheets("Feuil1").Range("b1").CurrentRegion.Value
For i = 2 To UBound(a, 1)
If Not dico.exists(a(i, 1)) Then
ReDim w(1 To 5, 1 To 1)
Else
w = dico.Item(a(i, 1))
If a(i, 3) > w(5, UBound(w, 2)) Then
ReDim Preserve w(1 To UBound(w, 1), 1 To UBound(w, 2) + 1)
End If
End If
If IsEmpty(w(1, UBound(w, 2))) Then
w(1, UBound(w, 2)) = a(i, 1)
w(2, UBound(w, 2)) = a(i, 3)
End If
If w(3, UBound(w, 2)) <> a(i, 3) Then
w(4, UBound(w, 2)) = w(4, UBound(w, 2)) + 1
End If
w(3, UBound(w, 2)) = a(i, 3)
w(5, UBound(w, 2)) = a(i, 3) + 1
dico.Item(a(i, 1)) = w
Next
With Sheets("feuil2").Range("a1")
.Parent.Cells.Clear
For i = 0 To dico.Count - 1
With .Offset(n).Resize(UBound(dico.items()(i), 2), UBound(dico.items()(i), 1) - 1)
.FormulaLocal = Application.Transpose(dico.items()(i))
.BorderAround Weight:=xlThin
End With
n = n + UBound(dico.items()(i), 2) + 1
Next
End With
Set dico = Nothing
End SubCeci est à revoir :
If w(3, UBound(w, 2)) <> a(i, 3) Then
w(4, UBound(w, 2)) = w(4, UBound(w, 2)) + 1
End Ifil faut boucler sur chaque clé et décompter les jours autrement
klin89
Re fred2406,
Les dates figurant en feuille source doivent être triées par ordre chronologique
Vois ceci :
Option Explicit
Sub test()
Dim a, w(), e, txt As String, dico As Object
Dim i As Long, j As Long, n As Long
Set dico = CreateObject("Scripting.Dictionary")
dico.CompareMode = 1
a = Sheets("Feuil1").Range("b1").CurrentRegion.Value
For i = 2 To UBound(a, 1)
txt = Join$(Array(a(i, 1), a(i, 2)), Chr(2))
If Not dico.exists(txt) Then
ReDim w(1 To 6, 1 To 1)
Else
w = dico.Item(txt)
If a(i, 3) > w(6, UBound(w, 2)) Then
ReDim Preserve w(1 To UBound(w, 1), 1 To UBound(w, 2) + 1)
End If
End If
If IsEmpty(w(1, UBound(w, 2))) Then
w(1, UBound(w, 2)) = a(i, 1)
w(2, UBound(w, 2)) = a(i, 2)
w(3, UBound(w, 2)) = a(i, 3)
End If
w(4, UBound(w, 2)) = a(i, 3)
w(6, UBound(w, 2)) = a(i, 3) + 1
dico.Item(txt) = w
Next
For Each e In dico.keys
w = dico.Item(e)
For j = 1 To UBound(w, 2)
w(5, j) = Evaluate("NB.JOURS.OUVRES(""" & w(3, j) & """,""" & w(4, j) & """)")
Next
dico.Item(e) = w
Next
With Sheets("feuil2").Range("a1")
.Parent.Cells.Clear
For i = 0 To dico.Count - 1
With .Offset(n).Resize(UBound(dico.items()(i), 2), UBound(dico.items()(i), 1) - 1)
.FormulaLocal = Application.Transpose(dico.items()(i))
.BorderAround Weight:=xlThin
End With
n = n + UBound(dico.items()(i), 2) + 1
Next
End With
Set dico = Nothing
End Subklin89
Bonsoir tout le monde
merci pour vos réponses je vais étudier cela demain
Bonne nuit
Fred
Re fred2406,
Résultat dans la variable b
Option Explicit
Sub test()
Dim a, b(), w(), e, txt As String, dico As Object
Dim i As Long, j As Long, n As Long, maxi As Long, pos
Set dico = CreateObject("Scripting.Dictionary")
dico.CompareMode = 1
a = Sheets("Feuil1").Range("b1").CurrentRegion.Value
For i = 2 To UBound(a, 1)
txt = Join$(Array(a(i, 1), a(i, 2)), Chr(2))
If Not dico.exists(txt) Then
ReDim w(1 To 6, 1 To 1)
Else
w = dico.Item(txt)
If a(i, 3) > w(6, UBound(w, 2)) Then
ReDim Preserve w(1 To UBound(w, 1), 1 To UBound(w, 2) + 1)
End If
End If
If IsEmpty(w(1, UBound(w, 2))) Then
w(1, UBound(w, 2)) = a(i, 1)
w(2, UBound(w, 2)) = a(i, 2)
w(3, UBound(w, 2)) = a(i, 3)
End If
w(4, UBound(w, 2)) = a(i, 3)
w(6, UBound(w, 2)) = a(i, 3) + 1
dico.Item(txt) = w
Next
ReDim b(1 To dico.Count, 1 To 5)
For Each e In dico.keys
w = dico.Item(e)
For j = 1 To UBound(w, 2)
w(5, j) = Evaluate("NB.JOURS.OUVRES(""" & w(3, j) & """,""" & w(4, j) & """)")
Next
dico.Item(e) = w
maxi = Application.Max(Application.Index(w, 5, 0))
pos = Application.Match(maxi, Application.Index(w, 5, 0), 0)
n = n + 1
For j = 1 To UBound(w, 1) - 1
b(n, j) = w(j, pos)
Next
Next
'Restitution en Feuil2
Application.ScreenUpdating = False
With Sheets("feuil2")
.Cells.Clear
With .Range("a1").Resize(UBound(b, 1), UBound(b, 2))
.FormulaLocal = b
.Font.Name = "calibri"
.Font.Size = 10
.BorderAround Weight:=xlThin
.Borders(xlInsideVertical).Weight = xlThin
.VerticalAlignment = xlCenter
.Columns.ColumnWidth = 12
End With
End With
Set dico = Nothing
Application.ScreenUpdating = True
End Subklin89
Bonjour Klin89, bonjour le forum
merci pour ton code qui a priori repond a la demande... j'attends toujours confirmation de la personne qui pose cette question....
chez moi ton code fonctionne (avant dernier... celui que tu as mis il y a 1/2 heure pas regardé encore...) et j'ai réussi a mon imprégner à une exception près.... je cherche encore un peu... mais si je n'y arrive pas je viendrais te poser une question
mais il y a une chose qui ne fonctionne pas .... c'est cette ligne
w(5, j) = Evaluate("NB.JOURS.OUVRES(""" & w(3, j) & """,""" & w(4, j) & """)")qui me renvoi une erreur
je l'ai remplacé par
w(4, j) = WorksheetFunction.NetworkDays(w(2, j), w(3, j))et c'est OK
la chose que je ne m'explique pas encore c'est que cette fonction nbjourouvré, attend un 3e paramètre en option correspondant aux jours fériés.. du pays dans lequel on est et j'avais commencé a mettre en mémoire les jours fériés, et je me suis aperçu que cette fonction, même sans ce paramètre en option, me comptait le 14 juillet comme jour non travaillé, et autres jours que j'ai pu tester...
merci et bon dimanche
fred
re
je viens de regarder ton dernier code, c'est bien... tu m'a fait quelque chose que j'étais entrain de faire ajouter le prénom dans le dico pour éviter les homonymes.... j'avais penser a quelque chose de similaire ça tombe bien...
fred
Re,
Tu listes les jours fériés dans une plage que tu nommes "feries"
et tu modifies comme ceci, cela fonctionne non !
For j = 1 To UBound(w, 2)
'w(5, j) = Evaluate("NB.JOURS.OUVRES(""" & w(3, j) & """,""" & w(4, j) & """)")
w(5, j) = Evaluate("NB.JOURS.OUVRES(""" & w(3, j) & """,""" & w(4, j) & """,feries)")
NextChez moi sous Excel 2003, ça fonctionne
ou ceci :
For j = 1 To UBound(w, 2)
w(5, j) = Evaluate("Networkdays(""" & w(3, j) & """,""" & w(4, j) & """,feries)")
'w(5, j) = Evaluate("NB.JOURS.OUVRES(""" & w(3, j) & """,""" & w(4, j) & """,feries)")
'w(5, j) = Evaluate("NB.JOURS.OUVRES(""" & w(3, j) & """,""" & w(4, j) & """)")
Nextklin89
Re
si j'utilise ta ligne de code :
w(5, j) = Evaluate("NB.JOURS.OUVRES(""" & w(3, j) & """,""" & w(4, j) & """,feries)")j'ai w(5,i) qui est egal à Erreur 2029
cela marche avec la ligne suivante
w(5, j) = WorksheetFunction.NetworkDays(w(3, j), w(4, j), Range("feries"))mais pas la tienne, mais je me demande si on est obligé de mettre ce tableau de dates....
autre question, est-il possible de mettre les jours feriés dans une varaible de type tableau au lieu de passer par une plage de cellule dans une feuille ?? car j'ai essayé de 3 façons possible je n'y arrive pas, la question est est ce que cela est même possible....
Fred
red2406 a dit :
autre question, est-il possible de mettre les jours feriés dans une varaible de type tableau au lieu de passer par une plage de cellule dans une feuille ?? car j'ai essayé de 3 façons possible je n'y arrive pas, la question est est ce que cela est même possible....
Oui, c'est possible, vois la manip dans le lien ci-dessous
https://excel2007manual.blogspot.com/2013/06/store-holidays-in-named-range.html
klin89
bonsoir
c'est pas tout a fait ce que je demandais... si j'ai bien compris c'est pour mettre dans une variable du gestionnaire de noms en dur comme ca si la plage est supprimée cela ne pose pas de problème ..... , l e problème c'est que chaque année faudrait faire une modif à la main ... je vais resté avec une feuille masquée cela fera l'affaire...
j'ai fais des recherches et a priori le 3e argument de cette fonction doit être un range... donc moi je sais pas convertir un tb() en range...
je problème viens de la
mais bon une autre solution est opérationnelle donc pas grave....
merci
fred
Bonsoir
je viens d'avoir les informations nécessaire... et Eriic avait raison..... quand un personne est absent une demi journée, elle n'est pas comptabilisée absente....
voici enfin le retour que j'ai eut ce soir ...
- 1 agent absent 1/2 journée sera compté comme présent, il faut être absent 1 journée complète pour que le décompte commence (dans l'idéal les jours fériés serait de neutraliser les jours fériés comme le sont les samedis et les dimanches)
- le comptage du nombre maximum d'absences est égal au nombre d'absences journalières complètes consécutives hors jours fériés, et week-end
Je vais donc essayé d'adapter le code Klin pour que cela fonctionne comme avec ce nouveau fonctionnement
Bonne soirée
Fred
bonjour faute de temps je clôture le sujet, une autre personne pourra aider la personne en question..
merci à tous
fred