Microsoft 365 Trouver Date début et date de fin

[eric72]

Bonjour à tous,
j'ai un planning avec des colonnes qui correspondent aux dates, puis j'attribue par vba des noms en dessous de ces dates, j'aimerais une formule qui, quand je saisie un nom en "M2" cela m'affiche la date de début et la date de fin de la période mais je cale!!!
j'ai essayé avec INDEX EQUIV mais sans succès
Auriez-vous une idée?
Merci beaucoup pour votre aide si précieuse.

 

[Eric KERGRESSE]

Bonjour,

A tester

 

[eric72]

Bonjour,

A tester

Bonjour Eric,
Rapide et Efficace, vous mettez fin à 2 heures de recherche active.
Merci beaucoup pour ce boulot
Bonne journée.

 

[Dranreb]

Bonjour.
Une version un peu différente utilisant un Dictionary.

 

[eric72]

Bonjour.
Une version un peu différente utilisant un Dictionary.

Bonjour Dranreb,
Merci pour la réponse, en effet cela fait bien le boulot également, au niveau performance, est-ce pareil?

 

[Dranreb]

Non, c'est vraisemblablement bien plus rapide, notamment s'il y a plus de lignes.

 

[eric72]

Bonjour.
Une version un peu différente utilisant un Dictionary.

Bonjour Dranreb,
Je n'ai pas voulu demander d'explications sur votre solution, j'ai donc tenté de l'adapter sur un autre tableau avec les dates en colonne au lieu de la ligne1 et j'ai tenté de l'adapter mais sans succès, pourriez-vous m'expliquer le détail de la fonction pour que je puisse l'adaper, tout cela afin de progresser et ne plus demander quand j'ai le même cas.
Merci beaucoup et bonne journée.
Eric

 

[Dranreb]

Bonjour.
Dans les références du projet VBA, cochez Microsoft Scripting Runtime.
Ensuite, la dates ne sont pas disposées horizontalement sur la 1ère ligne mais verticalement sur la 1ère colonne. Alors ce n'est pas C - 1 mais L - 1 qu'il faut ajouter à la date de début, lors de la constitution du Dictionary.
Mettez aussi les données sous forme de tableau nommé Tableau1, parce que là vous prenez avec, sinon, les intitulés de colonnes, ce qui entraine un décalage d'un jour en trop.

 

[eric72]

Bonjour.
Dans les références du projet VBA, cochez Microsoft Scripting Runtime.
Ensuite, la dates ne sont pas disposées horizontalement sur la 1ère ligne mais verticalement sur la 1ère colonne. Alors ce n'est pas C - 1 mais L - 1 qu'il faut ajouter à la date de début, lors de la constitution du Dictionary.
Mettez aussi les données sous forme de tableau nommé Tableau1, parce que là vous prenez avec, sinon, les intitulés de colonnes, ce qui entraine un décalage d'un jour en trop.

Re Bonjour,
En effet cela fonctionne bien, par contre si j'efface TOTO dans Archives et que je retape dans Planning, il garde en mémoire les dates. Pour qu'il prenne en compte le changement je dois fermer le fichier et le rouvrir
Connaissez vous la raison?
Merci beaucoup

 

[Dranreb]

Ajoutez cette procédure dans Module1 :

Sub SupprimerDico()
   Set Dic = Nothing
   End Sub

Et à la fin de la Sub InitDic :

   Application.OnTime Now + TimeSerial(0, 0, 1), "SupprimerDico"
   End Sub

Mais il se peut que ça ne marche pas dans la mesure où un Application.OnTime ne peut peut être pas être lancé pendant l'évaluation d'une formule.
Alors c'est peut être dans Une Private Sub Worksheet_Change qu'il faudrait supprimer le Dictionary risquant de devenir obsolète …

 

[eric72]

Ajoutez cette procédure dans Module1 :

Sub SupprimerDico()
   Set Dic = Nothing
   End Sub

Et à la fin de la Sub InitDic :

   Application.OnTime Now + TimeSerial(0, 0, 1), "SupprimerDico"
   End Sub

Mais il se peut que ça ne marche pas dans la mesure où un Application.OnTime ne peut peut être pas être lancé pendant l'évaluation d'une formule.
Alors c'est peut être dans Une Private Sub Worksheet_Change qu'il faudrait supprimer le Dictionary risquant de devenir obsolète …

Malheureusement cela ne change rien!!!
Désolé

 

[Dranreb]

C'est bien ce que je craignais.
Mettons dan ThisWorkbook :

Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
   SupprimerDico
   End Sub

 

[eric72]

C'est bien ce que je craignais.
Mettons dan ThisWorkbook :

Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
   SupprimerDico
   End Sub

Yessss, ça marche super!!!
Merci beaucoup pour votre aide ainsi qu'à Eric
Bonne soirée.
Eric

 

[Dranreb]

Essayez ça aussi :

Option Explicit
Private Dic As Dictionary, HDern As Date
Function DateDép(ByVal Nom As String, ByVal RngDon As Range, ByVal Date1 As Date)
   If HDern < Now Then InitDic RngDon, Date1
   If Dic.Exists(Nom) Then
      DateDép = Dic(Nom)(0)
   Else: DateDép = "": End If
   End Function
Function DateFin(ByVal Nom As String, ByVal RngDon As Range, ByVal Date1 As Date)
   If HDern < Now Then InitDic RngDon, Date1
   If Dic.Exists(Nom) Then
      DateFin = Dic(Nom)(1)
   Else: DateFin = "": End If
   End Function
Private Sub InitDic(ByVal RngDon As Range, ByVal Date1 As Date)
   Dim Cel As Range, Nom As String, TDat(), TDon(), L&, C%, TDF()
   Set Dic = New Dictionary
   TDon = RngDon.Value
   For L = 1 To UBound(TDon, 1)
      For C = 1 To UBound(TDon, 2)
         Nom = TDon(L, C)
         If Nom <> "" Then
            If Dic.Exists(Nom) Then
               TDF = Dic(Nom)
            Else
               TDF = Array(#12/31/9999#, 0)
               End If
            If TDF(0) > Date1 + L - 1 Then TDF(0) = Date1 + L - 1
            If TDF(1) < Date1 + L - 1 Then TDF(1) = Date1 + L - 1
            Dic(Nom) = TDF
            End If
         Next C, L
   HDern = Now + 1 / 86400
   End Sub

 

[mapomme]

Bonsoir @eric72 , à tous les autres ,

Avec des formules :

en M2, la liste des noms via une formule (spécifique à excel 365) :
=TRIER(UNIQUE(FILTRE(DANSCOL(A2:J24);DANSCOL(A2:J24)<>"")))

en N2, les dates de départ via une formule à copier vers le bas :
=MIN(SI($A$2:$J$24=$M2;$A$1:$J$1;""))

en O2, les dates de fin via une formule à copier vers le bas :
=MAX(SI($A$2:$J$24=$M2;$A$1:$J$1;""))

nota : les formules en N2 et O2 sont utilisables avec n'importe quelle version d'Excel. Comme ce sont des formules matricielles, les anciennes versions d'Excel nécessiteront une validation matricielle de ces formules par la combinaison des trois touches Ctrl+Maj+Entrée.