XL 2010 recherche le nom entre deux date

[yahya belbachir]

Bonjour
pouvez vous m'aider de trouver le nom entre deux dates et ciblé par la valeur d'un objet (chambre).
je porte mon fichier çi joint, j'ai coloré en jaune les cellule que je cherche .
pour bien préciser les base des données sont dans l'ongletFiche_client) et je veux le resultat dans l'onglet (Plan_occ).
merci
Cordialement
YAHYA

 

[yahya belbachir]

Avant que je ne ferme le fichier sans l'enregistrer, dans un module standard :

Option Explicit
Sub DateSuivante()
   Feuil2.[H2].Value = Feuil2.[H2].Value + 1
   PlanOccupation
   End Sub
Sub DatePrécédente()
   Feuil2.[H2].Value = Feuil2.[H2].Value - 1
   PlanOccupation
   End Sub
Sub PlanOccupation()
   Dim TDon(), L&, TRés(), LR&, CR&, LaDate As Date, N&
   TDon = Feuil3.ListObjects(1).DataBodyRange.Value
   TRés = Feuil2.[C5:N19].Value
   For LR = 3 To 15 Step 3: For CR = 1 To 12: TRés(LR, CR) = Empty: Next CR, LR
   LaDate = Feuil2.[H2].Value
   For L = 1 To UBound(TDon, 1)
      If TDon(L, 11) <= LaDate And TDon(L, 12) > LaDate Then
         CR = TDon(L, 4): LR = 18 - (CR \ 100) * 3: CR = (CR Mod 100) * 2
         N = TRés(LR, CR - 1) + 1
         TRés(LR, CR - 1) = N
         If N > 1 Then
            TRés(LR, CR) = TRés(LR, CR) & vbLf & TDon(L, 5)
         Else: TRés(LR, CR) = TDon(L, 5)
            End If: End If: Next L
   Feuil2.[C5:N19].Value = TRés
   End Sub

Dans la feuille "Plan_occ" affectez les macros DateSuivante et DatePrécédente aux images de flèches, et dans le module de l'objet Worksheet Feuil2 qui la représente :

Option Explicit
Private Sub Worksheet_Activate()
   PlanOccupation
   End Sub

Bonjour Danreb
je m'excuse pour le dérangement
je me damande si je peux ajouter des commentaires dans le planing que vous m'avez aider,par exemple dans la case cibler par le nom si je pose la souris dans la celulle ou se trouve le nom cible dans le planning il me donne des informations sous forme de commentaire(add.comments).
si c'est possible,j'ai tenté plusieurs fois mais je n'ai pas réussi à le faire,merci

 

[Dranreb]

Bonsoir.
Je n'ai rien gardé de cette histoire, et je ne vois plus du tout de quoi il s'agit.
Joignez peut être un classeur muni de ce que vous avez essayé, avec une explication du résultat que vous en attendez.

 

[yahya belbachir]

Bonsoir.
Je n'ai rien gardé de cette histoire, et je ne vois plus du tout de quoi il s'agit.
Joignez peut être un classeur muni de ce que vous avez essayé, avec une explication du résultat que vous en attendez.

voilà j'ai mis le fichier joint sauf vous allez l'ouvrir pour comprendre,ce que je cherche.
et merci pour le soutien

 

[Dranreb]

Je ne vous suis pas encore très bien. Est ce bien un commentaire fixe que vous voulez mettre dans la cellule, ou pas plutôt un affichage temporaire d'informations prises de la feuille "Fiche client" ?

 

[yahya belbachir]

Je ne vous suis pas encore très bien. Est ce bien un commentaire fixe que vous voulez mettre dans la cellule, ou pas plutôt un affichage temporaire d'informations prises de la feuille "Fiche client" ?

exactement information prise par le client,si un client se change le commentaire se change aussi.

 

[Dranreb]

C'est compliqué parce que théoriquement plusieurs lignes de la feuille "Fiche_Client" peuvent concerner une chambre …

 

[yahya belbachir]

C'est compliqué parce que théoriquement plusieurs lignes de la feuille "Fiche_Client" peuvent concerner une chambre …

il n y a pas de probléme,je vous remercie pour le soutien.
je le savais que c'est compliqué c'est pour ça que je vous ai adressé.
merci Danreb

 

[Dranreb]

On aurait plus simple de faire en sorte que la Sub Worksheet_Activate mette un renvoi vers la cellule du nom plutôt que le nom,
et d'écrire une Sub Worksheet_SelectionChange qui reconnait cette formule et affiche le reste dans une MsgBox quand on sélectionne la cellule. Ça pourrait donner quelque chose comme ça :

Option Explicit
Private Sub Worksheet_Activate()
   Dim RDon As Range, TDon(), L&, TRés(), LR&, CR&, N&, Expr$
   Set RDon = Feuil3.ListObjects(1).DataBodyRange
   TDon = RDon.Value
   TRés = Me.[C5:N19].Value
   For LR = 3 To 15 Step 3: For CR = 1 To 12: TRés(LR, CR) = Empty: Next CR, LR
   For L = 1 To UBound(TDon, 1)
      If Date >= TDon(L, 11) And Date < TDon(L, 12) Then
         CR = TDon(L, 4): LR = 18 - (CR \ 100) * 3: CR = (CR Mod 100) * 2
         N = TRés(LR, CR - 1) + 1
         TRés(LR, CR - 1) = N
         If N > 1 Then
            TRés(LR, CR) = TRés(LR, CR) & "&""" & vbLf & """&" & RDon(L, 5).Address(External:=True) ' TDon(L, 5)
         Else: TRés(LR, CR) = "=" & RDon(L, 5).Address(External:=True) 'TDon(L, 5)
            End If: End If: Next L
   Me.[C5:N19].Value = TRés
   End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   Dim TJn() As String, N&, Cel As Range
   If Target.Rows.Count > 1 Or Target.Columns.Count > 1 Then Exit Sub
   If Not Target.HasFormula Then Exit Sub
   TJn = Split(Mid$(Target.Formula, 2), "&""" & vbLf & """&")
   For N = 0 To UBound(TJn)
      Set Cel = Evaluate(TJn(N))
      TJn(N) = Cel.Value & " " & Cel(1, 2).Value & ", " & Format(Cel(1, 7).Value, "dd/mm/yyyy") & " - " & Format(Cel(1, 8).Value, "dd/mm/yyyy")
      Next N
   MsgBox Join(TJn, vbLf), vbInformation, Me.Name
   End Sub

 

[yahya belbachir]

On aurait plus simple de faire en sorte que la Sub Worksheet_Activate mette un renvoi vers la cellule du nom plutôt que le nom,
et d'écrire une Sub Worksheet_SelectionChange qui reconnait cette formule et affiche le reste dans une MsgBox quand on sélectionne la cellule. Ça pourrait donner quelque chose comme ça :

Option Explicit
Private Sub Worksheet_Activate()
   Dim RDon As Range, TDon(), L&, TRés(), LR&, CR&, N&, Expr$
   Set RDon = Feuil3.ListObjects(1).DataBodyRange
   TDon = RDon.Value
   TRés = Me.[C5:N19].Value
   For LR = 3 To 15 Step 3: For CR = 1 To 12: TRés(LR, CR) = Empty: Next CR, LR
   For L = 1 To UBound(TDon, 1)
      If Date >= TDon(L, 11) And Date < TDon(L, 12) Then
         CR = TDon(L, 4): LR = 18 - (CR \ 100) * 3: CR = (CR Mod 100) * 2
         N = TRés(LR, CR - 1) + 1
         TRés(LR, CR - 1) = N
         If N > 1 Then
            TRés(LR, CR) = TRés(LR, CR) & "&""" & vbLf & """&" & RDon(L, 5).Address(External:=True) ' TDon(L, 5)
         Else: TRés(LR, CR) = "=" & RDon(L, 5).Address(External:=True) 'TDon(L, 5)
            End If: End If: Next L
   Me.[C5:N19].Value = TRés
   End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   Dim TJn() As String, N&, Cel As Range
   If Target.Rows.Count > 1 Or Target.Columns.Count > 1 Then Exit Sub
   If Not Target.HasFormula Then Exit Sub
   TJn = Split(Mid$(Target.Formula, 2), "&""" & vbLf & """&")
   For N = 0 To UBound(TJn)
      Set Cel = Evaluate(TJn(N))
      TJn(N) = Cel.Value & " " & Cel(1, 2).Value & ", " & Format(Cel(1, 7).Value, "dd/mm/yyyy") & " - " & Format(Cel(1, 8).Value, "dd/mm/yyyy")
      Next N
   MsgBox Join(TJn, vbLf), vbInformation, Me.Name
   End Sub

merci beaucoup Danreb
hhh
je n'imagine pas ça, cela est mieux que je croix,
merci infiniment