Microsoft 365 Trouver Date début et date de fin

eric72 · 18 Janvier 2024

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.

Dranreb · 19 Janvier 2024

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

VB:

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

Eric KERGRESSE · 18 Janvier 2024

Bonjour,

A tester

eric72 · 18 Janvier 2024

Eric KERGRESSE à dit:
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 · 18 Janvier 2024

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

eric72 · 18 Janvier 2024

Dranreb à dit:
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 · 18 Janvier 2024

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

eric72 · 19 Janvier 2024

Dranreb à dit:
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 · 19 Janvier 2024

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 · 19 Janvier 2024

Dranreb à dit:
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 · 19 Janvier 2024

Ajoutez cette procédure dans Module1 :

VB:

Sub SupprimerDico()
   Set Dic = Nothing
   End Sub

Et à la fin de la Sub InitDic :

VB:

   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 · 19 Janvier 2024

Dranreb à dit:
Ajoutez cette procédure dans Module1 :

VB:

Sub SupprimerDico() Set Dic = Nothing End Sub

Et à la fin de la Sub InitDic :

VB:

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 · 19 Janvier 2024

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

VB:

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

eric72 · 19 Janvier 2024

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

VB:

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 · 19 Janvier 2024

Essayez ça aussi :

VB:

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 · 19 Janvier 2024

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.

Microsoft 365 Trouver Date début et date de fin

eric72

XLDnaute Accro

Pièces jointes

Dranreb

Eric KERGRESSE

XLDnaute Occasionnel

Pièces jointes

eric72

XLDnaute Accro

Dranreb

XLDnaute Barbatruc

Pièces jointes

eric72

XLDnaute Accro

Dranreb

XLDnaute Barbatruc

eric72

XLDnaute Accro

Pièces jointes

Dranreb

XLDnaute Barbatruc

eric72

XLDnaute Accro

Pièces jointes

Dranreb

XLDnaute Barbatruc

eric72

XLDnaute Accro

Pièces jointes

Dranreb

XLDnaute Barbatruc

eric72

XLDnaute Accro

Dranreb

XLDnaute Barbatruc

mapomme

XLDnaute Barbatruc

Pièces jointes

Discussions similaires