XL 2010 recherche le nom entre deux date

Y

yahya belbachir

XLDnaute Occasionnel
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'onglet:(Fiche_client) et je veux le resultat dans l'onglet (Plan_occ).
merci
Cordialement
YAHYA
 

Pièces jointes

  • test_planning.xlsm
    48.6 KB · Affichages: 12
Trier par date Trier par votes
Dranreb

Dranreb

XLDnaute Barbatruc
Bonjour.
Avec ce code dans le module de la feuille :
VB: 
Option Explicit
Private Sub Worksheet_Activate()
   Dim TDon(), L&, TRés(), C&, N&
   TDon = Feuil3.ListObjects(1).DataBodyRange.Value
   ReDim TRés(1 To 1, 1 To 12)
   For L = 1 To UBound(TDon, 1)
      If Date >= TDon(L, 11) And Date < TDon(L, 12) Then
         C = (TDon(L, 4) * 2 - 1000)
         N = TRés(1, C - 1) + 1
         TRés(1, C - 1) = N
         If N > 1 Then
            TRés(1, C) = TRés(1, C) & vbLf & TDon(L, 5)
         Else: TRés(1, C) = TDon(L, 5)
            End If: End If: Next L
   [C7:N7].Value = TRés
   End Sub
 
Vote positif 0 Vote négatif
Y

yahya belbachir

XLDnaute Occasionnel
Dranreb à dit:
Bonjour.
Avec ce code dans le module de la feuille :
VB: 
Option Explicit
Private Sub Worksheet_Activate()
   Dim TDon(), L&, TRés(), C&, N&
   TDon = Feuil3.ListObjects(1).DataBodyRange.Value
   ReDim TRés(1 To 1, 1 To 12)
   For L = 1 To UBound(TDon, 1)
      If Date >= TDon(L, 11) And Date < TDon(L, 12) Then
         C = (TDon(L, 4) * 2 - 1000)
         N = TRés(1, C - 1) + 1
         TRés(1, C - 1) = N
         If N > 1 Then
            TRés(1, C) = TRés(1, C) & vbLf & TDon(L, 5)
         Else: TRés(1, C) = TDon(L, 5)
            End If: End If: Next L
   [C7:N7].Value = TRés
   End Sub
Cliquez pour agrandir...
Merci pour votre réponse
j'ai éssayé mais cela n'a pas fonctionné.
merci
 
Vote positif 0 Vote négatif
Y

yahya belbachir

XLDnaute Occasionnel
Dranreb à dit:
Chez moi ça fonctionne. L'avez vous bien mis dans le module Feuil2 (plan_occ) et non dans un module standard ?
Cliquez pour agrandir...
ah bon
merci infiniment
je l'ai essayé dans le tableau de test que j'ai posté ici, et ça marche.
mon problème que j'ai un tableau de 5 étage,je vais vous l'envoyé pour me le rectifié c'est pour cela qu'il ne marche pas
çi joint ce fichier
 

Pièces jointes

  • test_planning2.xlsm
    57.9 KB · Affichages: 7
Vote positif 0 Vote négatif
Dranreb

Dranreb

XLDnaute Barbatruc
Corrigez comme ceci :
VB: 
Option Explicit
Private Sub Worksheet_Activate()
   Dim TDon(), L&, TRés(), LR&, CR&, N&
   TDon = Feuil3.ListObjects(1).DataBodyRange.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 & TDon(L, 5)
         Else: TRés(LR, CR) = TDon(L, 5)
            End If: End If: Next L
   Me.[C5:N19].Value = TRés
   End Sub
 
Vote positif 0 Vote négatif
Y

yahya belbachir

XLDnaute Occasionnel
Dranreb à dit:
Corrigez comme ceci :
VB: 
Option Explicit
Private Sub Worksheet_Activate()
   Dim TDon(), L&, TRés(), LR&, CR&, N&
   TDon = Feuil3.ListObjects(1).DataBodyRange.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 & TDon(L, 5)
         Else: TRés(LR, CR) = TDon(L, 5)
            End If: End If: Next L
   Me.[C5:N19].Value = TRés
   End Sub
Cliquez pour agrandir...
un très grand merci Monsieur tu m'as résolu un problème qui m'a troublé la tête depuis longtemps,
juste petite chose,si c'est possible sinon,il n ya aucun problème.
dans la feuil 5 il y une cellule coloré en jaune, si un client et présent entre deux dates, alors affiche dans la cellule jaune le MOT "REC" dans la ligne "E" si son départ égal à aujourd’hui affiche le mot "DEP" dans la ligne "F" juste en face au numéro de la chambre.
si ça vous dérange il n y a aucun problème,car l'essentiel est résolue
Merci Infiniment
 
Vote positif 0 Vote négatif
Y

yahya belbachir

XLDnaute Occasionnel
Bonsoir
excusez moi pour ce dérangement,j'ai trouvé dans mon tableau de base des données un formule que je veux l'envoyé dans le (Plan_men) qui sont coloré en jaune.
sincèrement un grand merci car j'en ai besoin de se fichier dans notre hotel
Cordialement
 

Pièces jointes

  • TEST.xlsm
    61 KB · Affichages: 4
Vote positif 0 Vote négatif
Dranreb

Dranreb

XLDnaute Barbatruc
Écrivez donc plutôt une Worksheet_Activate pour le Feuil5 (Plan_mem) à peu près sur le même modèle que celle du Feuil2 (Plan_occ)
Et virez moi ces instructions débiles que vous y avez ajoutées.
Et autre chose: je vois que vous avez remplacé la date du jour par celle de la cellule H2. Ne consultez donc pas sans arrêt cette cellule ! Chargez la au début dans une variable !
Mais ça ne va plus de le mettre dans la Worksheet_Activate si vous voulez pouvoir changer cette date. Il vaut mieux le mettre dans un module standard je crois.
 
Vote positif 0 Vote négatif
Y

yahya belbachir

XLDnaute Occasionnel
Dranreb à dit:
Écrivez donc plutôt une Worksheet_Activate pour le Feuil5 (Plan_mem) à peu près sur le même modèle que celle du Feuil2 (Plan_occ)
Et virez moi ces instructions débiles que vous y avez ajoutées.
Et autre chose: je vois que vous avez remplacé la date du jour par celle de la cellule H2. Ne consultez donc pas sans arrêt cette cellule ! Chargez la au début dans une variable !
Mais ça ne va plus de le mettre dans la Worksheet_Activate si vous voulez pouvoir changer cette date. Il vaut mieux le mettre dans un module standard je crois.
Cliquez pour agrandir...
essayez de jeter un coup d'oeil ici
presque je viens de comprendre mais je ne sais pas ou viens leprobléme,peut être probléme de cellule,car mieux j'ai bien clasé les cellules
 

Pièces jointes

  • TEST.2.xlsm
    101.1 KB · Affichages: 6
Vote positif 0 Vote négatif
Dranreb

Dranreb

XLDnaute Barbatruc
Bonjour.
La plage étant plus simple on a meilleur temps de partir d'un tableau vba vide.
Pas besoin de lui changer son nom, les variable déclarées dans une procédures son locales de toute façon et connues seulement dedans.
Le début :
VB: 
Private Sub Worksheet_Activate()
   Dim LaDate As Date, TDon(), L&, TRés(), LR&, CR&, N&
   TDon = Feuil3.ListObjects(1).DataBodyRange.Value
   ReDim TRés(1 To 7, 1 To 25)
   For N = 1 To 5: CR = (N - 1) * 5 + 1
      For LR = 1 To 6: TRés(LR, CR) = N * 100 + LR: Next LR
      TRés(7, CR) = "TOT": Next N
   LaDate = Me.[L2].Value
Dans la suite vous n'avez pas du tout corrigé le calcul de LR et CR en fonction du numéro de chambre, alors que c'est disposé complètement autrement. Essayez de faire la suite vous même.
VB: 
   For L = 1 To UBound(TDon, 1)
      N = TDon(L, 4): CR = (N \ 100 - 1) * 5 + 1: LR = N Mod 100
      If TDon(L, 11) <= LaDate And TDon(L, 12) > LaDate Then
         TRés(LR, CR + 2) = TRés(LR, CR + 2) + 1
         TRés(7, CR + 2) = TRés(7, CR + 2) + 1: End If
      If LaDate = TDon(L, 11) Then TRés(LR, CR + 3) = ChrW(10004)
      If LaDate = TDon(L, 12) Then TRés(LR, CR + 4) = ChrW(10008)
      Next L
   Me.[B7:Z13].Value = TRés
   End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
Dranreb

Dranreb

XLDnaute Barbatruc
Avant que je ne ferme le fichier sans l'enregistrer, dans un module standard :
VB: 
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 :
VB: 
Option Explicit
Private Sub Worksheet_Activate()
   PlanOccupation
   End Sub
 
Vote positif 0 Vote négatif
Y

yahya belbachir

XLDnaute Occasionnel
Dranreb à dit:
Avant que je ne ferme le fichier sans l'enregistrer, dans un module standard :
VB: 
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 :
VB: 
Option Explicit
Private Sub Worksheet_Activate()
   PlanOccupation
   End Sub
Cliquez pour agrandir...
je vous remercie de tout mon coeur pour tout ces efforts et de votre assistance favorable.
merci infiniment Monsieur
Cordialement
 
Vote positif 0 Vote négatif

Discussions similaires

3
  • Question
XL 2013 Recherche a plusieurs critéres
Réponses
2
Affichages
226
Gégé-45550
Gégé-45550
LB04
  • Question
XL 2019 compter les vendredi entre deux dates
Réponses
11
Affichages
258
LB04
LB04
D
  • Question
XL 2021 VBA - Copies automatique de données entre deux tableaux structurés
Réponses
0
Affichages
260
Drapela
D
chilo27
  • Question
Autres trier entre deux dates
Réponses
6
Affichages
352
JHA
J
8
  • Question
XL 2021 Nom de feuille vba
Réponses
5
Affichages
189
89ric
8
T
  • Résolu(e)
XL 2010 VBA - Lister fichiers et décortiquer le nom des fichiers dans colonne A et B
Réponses
5
Affichages
156
sylvanu
sylvanu
M
  • Résolu(e)
XL 2016 Recherche de date et de valeurs en fonction des dates
2 3
Réponses
36
Affichages
731
M@xu3L
M
V
  • Résolu(e)
XL 2013 Obtenir le produit de deux cellules sur base d'un menu déroulant
Réponses
6
Affichages
166
Vaaal
V
C
  • Question
XL 2016 Aide sur la fonction recherche V ou autre
Réponses
4
Affichages
218
cece44
C
M
  • Résolu(e)
XL 2013 Calcul des heures travaillées de jour, de nuit et plus de 24h consécutives
2 3
Réponses
41
Affichages
1 K
Manutela
M

Membres actuellement en ligne

7 membres et 75 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 177
Messages
2 085 972
Membres
103 073
dernier inscrit
MSCHOE16