Formule facilitant la visulation d'un planning de travail
Bonjour,
Alors voilà, ça fait quelque temps que je penche sur mon sujet mais je n'arrive pas à trouver la solution... J'ai essayé plusieurs formules, retourné mon tableau dans tous les sens sur Power Qwery également.
Ma donnée (cf pièce jointe):
J'ai un tableau d'effectif avec les noms en ligne et les dates en colonne. Chaque cellule correspond à l'activité d'une personne à une date donnée.
Mon objectif (cf tableau 2 en rouge):
1 ) Choisir une date (cellule en jaune), pour cette date avoir un tableau qui récapitule en fonction du nom de la présence son activité (aucun problème avec Power Qwery, j'ai réussi).
2) Pour chaque personne, avoir l'information de quand débute cette activité et quand elle se termine. C'est là que ça pêche.... Je ne trouve pas de formule me permettant cela.
Si quelqu'un à une orientation pour moi ça m'aiderait beaucoup !
Je suis Excel 2016 et impossible d'avoir une version supérieure... J'ai vu beaucoup d'exmple avec des formules qui malheureusement ne s'appliquent pas dans mon cas.
Bonne journée,
Excelmentement,
M.
Bonjour à tous !
Et....
La précision concernant votre Excel est à porter dans votre profil.
Je vous livre une approche via Power Query :
Bonjour JFL,
C'est exactement ça pour le rendu, merci beaucoup ! :)
Je ne comprends pas encore toutes les étapes mais je vais étudier tout ça pour ne pas recopier bêtement votre réponse.
Cordialement,
M.
Bonjour JFL,
Finalement, ce n'est pas tout à fait ça.. Dans la version que vous proposez, ça ne donne l'information "du" et "au" que sur une semaine. Cependant, les activités ont régulièrement lieu sur plusieurs semaines voire des mois.
Je vais tenter de mon côté et posterai si je trouve une solution.
Merci encore pour l'aide apportée;
M.
Bonjour à tous !
Cette contrainte n'était pas initialement énoncée.
Version 2 :
EDIT :
Pour le "fun", une version bis légèrement optimisée :
Bonsoir le forum,
Je me suis basé sur le fichier initial, attention au format des dates en 1ère ligne qui semblent être du texte.
Option Explicit
Sub determine_periode()
Dim rngL As Range, rngC As Range, Rng As Range, r As Range
Dim posC, posL
Dim debut As Long, fin As Long
Dim valeurRecherchee As String
Dim ws As Worksheet
' Définition de la feuille de travail
Set ws = Sheets("Feuil1")
' Définition des plages
Set rngL = ws.Range("A1").CurrentRegion.Rows(1) ' Ligne 1 (en-tête)
Set rngC = ws.Range("A1").CurrentRegion.Columns(1) ' Colonne 1 (indice)
Set Rng = ws.Range("C13:F" & ws.Cells(ws.Rows.Count, 3).End(xlUp).Row) ' Plage cible
' Trouve la position de la date recherchée dans la ligne d'en-tête
posC = Application.Match(ws.Range("D10").Value2, rngL, 0)
If Not IsError(posC) Then
' Boucle sur chaque cellule de la première colonne de Rng
For Each r In Rng.Columns(1).Cells
posL = Application.Match(r.Value2, rngC, 0)
If Not IsError(posL) Then
valeurRecherchee = ws.Cells(posL, posC).Value
' Trouve la position de début de la séquence de la valeur recherchée
debut = posC
Do While debut > 1 And ws.Cells(posL, debut - 1).Value = valeurRecherchee
debut = debut - 1
Loop
' Trouve la position de fin de la séquence de la valeur recherchée
fin = posC
Do While fin < ws.Cells(posL, ws.Columns.Count).End(xlToLeft).Column _
And ws.Cells(posL, fin + 1).Value = valeurRecherchee
fin = fin + 1
Loop
' Remplit les colonnes de la plage Rng avec la valeur recherchée et les bornes de la séquence
r.Offset(0, 1).Value = valeurRecherchee
r.Offset(0, 2).Value = rngL.Cells(1, debut).Value
r.Offset(0, 3).Value = rngL.Cells(1, fin).Value
End If
Next r
End If
End SubPas pris connaissance de vos dernières interventions
klin89
Re mo_kt,
Tu dis ceci :
Finalement, ce n'est pas tout à fait ça.. Dans la version que vous proposez, ça ne donne l'information "du" et "au" que sur une semaine.
Cependant, les activités ont régulièrement lieu sur plusieurs semaines voire des mois
Donc pour chaque nom, tu veux ressortir toutes les périodes d'activité correspondantes à une date définie .... si j'ai bien compris
Essaie ceci, résultat dans une feuille annexe.
Option Explicit
Sub test()
Dim a, b, pos, i As Long, ii As Long, iii As Long, n As Long, correspondance As String
a = Sheets("Feuil1").Range("A1").CurrentRegion.Value
pos = Application.Match(CStr(Sheets("Feuil1").Range("D9").Value), Application.Index(a, 1, 0), 0)
If Not IsError(pos) Then
ReDim b(1 To 100, 1 To 4)
For i = 2 To UBound(a, 1)
correspondance = a(i, pos)
For ii = 2 To UBound(a, 2)
iii = 0
Do While a(i, ii + iii) = correspondance
' Remplit les informations dans b(n, ...)
If b(n + 1, 1) = "" Then b(n + 1, 1) = a(i, 1) ' le Nom
If b(n + 1, 2) = "" Then b(n + 1, 2) = correspondance
' Debut de la séquence de la correspondance
If b(n + 1, 3) = "" Then b(n + 1, 3) = a(1, ii + iii)
' Fin de la séquence de la correspondance
b(n + 1, 4) = a(1, ii + iii)
iii = iii + 1
' Sort de la boucle si fin de ligne
If ii + iii > UBound(a, 2) Then Exit Do
Loop
' Passe à la séquence suivante uniquement s'il y avait une séquence correspondance
If iii > 0 Then
n = n + 1
ii = ii + iii - 1
End If
Next
Next
' Restitution
Application.ScreenUpdating = False
If Not Evaluate("isref('Resultat'!a1)") Then Sheets.Add(, Sheets(Sheets.Count)).Name = "Resultat"
With Sheets("Resultat")
With .Cells(1)
.CurrentRegion.Clear
If n > 0 Then
.Resize(, 4).Value = [{"Nom", "Activité", "Du", "Au"}]
.Offset(1).Resize(n, 4).Value = b
With .CurrentRegion
.Font.Name = "calibri"
.Font.Size = 10
.VerticalAlignment = xlCenter
.Borders(xlInsideVertical).Weight = xlThin
.BorderAround Weight:=xlThin
With .Rows(1)
.HorizontalAlignment = xlCenter
.Font.Size = 11
.BorderAround Weight:=xlThin
.Interior.ColorIndex = 43
End With
.Columns.ColumnWidth = 14
End With
End If
End With
End With
Application.ScreenUpdating = True
End If
End Subklin89
bonjour mo_kt, salut Klin89, JFL,
c'est possible avec des formules en excel 2016 (pour le moment, je dois encore ajouter des choses en cas d'erreur, si vous êtes intéressé ...)
Cela suppose des dates au lieu des textes (ligne 1) !!!
Bonjour,
Je vous remercie pour toutes vos réponses.
Je n'ai pas encore eu le temps d'étudier vos propositions, c'est vrai que celle de @JFL me convient très bien (encore merci). Mais je vais regarder tout ça !
Actuellement je suis plutôt sur la mise en forme de ma donnée sous un autre format (encore et toujours, il faut des tableaux pour tout le monde...)
Bonne soirée
M.
Re à tous,
Une modification pour englober les week-ends
Option Explicit
Sub test()
Dim a, b, pos, i As Long, ii As Long, iii As Long, n As Long, correspondance As String
a = Sheets("Feuil1").Range("A1").CurrentRegion.Value
pos = Application.Match(CStr(Sheets("Feuil1").Range("D9").Value), Application.Index(a, 1, 0), 0)
If Not IsError(pos) Then
ReDim b(1 To 100, 1 To 4)
For i = 2 To UBound(a, 1)
correspondance = a(i, pos)
For ii = 2 To UBound(a, 2)
iii = 0
' Commence à rechercher la correspondance
Do While a(i, ii + iii) = correspondance
' Remplit les informations dans b(n, ...)
If b(n + 1, 1) = "" Then b(n + 1, 1) = a(i, 1)
If b(n + 1, 2) = "" Then b(n + 1, 2) = correspondance
If b(n + 1, 3) = "" Then b(n + 1, 3) = a(1, ii + iii)
' Fin de la séquence de la correspondance
b(n + 1, 4) = a(1, ii + iii)
iii = iii + 1
' Sort de la boucle si fin de ligne
If ii + iii > UBound(a, 2) Then Exit Do
Loop
' Passe à la séquence suivante uniquement s'il y avait une séquence correspondance
If iii > 0 Then
n = n + 1
' Vérifier si la séquence actuelle commence un lundi et la précédente se termine un vendredi
If n > 1 Then
If Weekday(b(n - 1, 4), vbMonday) = 5 And Weekday(b(n, 3), vbMonday) = 1 Then
' Fusionner avec la séquence précédente
b(n - 1, 4) = b(n, 4)
' Ne pas incrémenter n et supprimer la séquence actuelle
b(n, 1) = ""
b(n, 2) = ""
b(n, 3) = ""
b(n, 4) = ""
n = n - 1
End If
End If
ii = ii + iii - 1 ' Mettre à jour ii pour la prochaine itération
End If
Next ii
Next i
' Restitution et mise en forme
Application.ScreenUpdating = False
If Not Evaluate("isref('Resultat'!a1)") Then Sheets.Add(, Sheets(Sheets.Count)).Name = "Resultat"
With Sheets("Resultat")
With .Cells(1)
.CurrentRegion.Clear
If n > 0 Then
.Resize(, 4).Value = [{"Nom", "Activité", "Du", "Au"}]
.Offset(1).Resize(n, 4).Value = b
With .CurrentRegion
.Font.Name = "Calibri"
.Font.Size = 10
.VerticalAlignment = xlCenter
.Borders(xlInsideVertical).Weight = xlThin
.BorderAround Weight:=xlThin
With .Rows(1)
.HorizontalAlignment = xlCenter
.Font.Size = 11
.BorderAround Weight:=xlThin
.Interior.ColorIndex = 43
End With
.Columns.ColumnWidth = 19
.Columns("c:d").NumberFormatLocal = "jjj jj mmmm aaaa"
End With
End If
End With
End With
Application.ScreenUpdating = True
End If
End Subklin89