rechercher une date sous excel

rechercher une date sous excel - VB/VBA/VBS - Programmation

Marsh Posté le 07-03-2005 à 11:30:26    

Bonjour a tous,
 
voila mon pb:
 
j'ai un tableau excel.
Dans ce tableau, j'ai une colonne (k:) qui contient des dates et des cellules vides.
 
Je dois aussi recuperer la date du jour et la convertir en numero de semaine.
 
Mon programme doit lire la colonne(k:), quand il trouve une date il la transforme en numero de semaine et la compare avec mon numero de semaine de la date du jour. Si les numeros sont egaux alors j'incremente une variable et le programme continue pour verifier si d'autres dates correspondent sinon le programmes continue jusqu'a trouver une autre date.
 
J'arrive a recuperer la date du jour et a la transformer par contre je n'arrive pas a faire le reste .
 
Si quelqu'un veut bien m'aider.
Merci.
Cordialement.

Reply

Marsh Posté le 07-03-2005 à 11:30:26   

Reply

Marsh Posté le 07-03-2005 à 11:40:26    

J'ai bien une solution mais j'ai d'abord une question : Les cellules vides sont beaucoup espacées ?

Reply

Marsh Posté le 07-03-2005 à 11:52:32    

Bonjour,
Normalement a termes, il ne doit pas y avoir de cellules vides. Il s'agit d'une colonne ou sont stocke des dates de rendez vous. Pour l'instant c'est aleatoire mais je n'ai pas par exemple: 1 date et 10 cellules vides.
 
Voila.
 
J'attends ta reponse
Merci

Reply

Marsh Posté le 07-03-2005 à 12:04:47    

Bon voilà le code :

Code :
  1. For i = 1 To Range("A1" ).End(xlDown).Row
  2.      ' Range("A" & i).Value  Ici ton code de remplacement de date par numéro de semaine et test.
  3.      Next i


(Remplace A par ta colonne et les 1 (i=1 et "A1" ) par la première ligne a traiter. Si 3 : For i=3 .. "A3" )
Le problème majeur c'est qu'il s'arrête a la première cellule vide  :fou: . Sinon on fait le classeur complet (65000 ligne au moins)...
Une solution consisterai a s 'arrêter à un certain nombre... mais si il doit changer, il faut modifier le prog ...

Reply

Marsh Posté le 07-03-2005 à 12:33:26    

Merci knakes pur ta reponse.
 
Neanmoins il ya truc que je comprend pas c'est dans quoi tu stocke ta variable pour que je puisse la transformer en numeros de semaine.
 
Merci.
PS: je debute en vb, je comprends vite mais faut m'expliquer longtemps, longtemps, longtemps, .......

Reply

Marsh Posté le 07-03-2005 à 12:34:38    

Quel est ton code pour transformer une date en numéro de semaine ?

Reply

Marsh Posté le 07-03-2005 à 13:38:34    

Voila mon code:
 
Dim Valeur As Date
TheDate = Now
Var = DatePart("ww", TheDate, , vbFirstFourDays)
 
Je recupere la date du jour avec Now et je la convertie avec datepart. je sais que datepart est pas parfait par rapport au 29/12/03 mais bon je fais avec.
 
Voila

Reply

Marsh Posté le 07-03-2005 à 17:21:14    

Donc voila un bout du programme

Code :
  1. Dim a As Long
  2. a = 0
  3. For i = 1 To Range("A1" ).End(xlDown).Row
  4.   If DatePart("ww", Range("A" & i).Value, , vbFirstFourDays) = DatePart("ww", Now, , vbFirstFourDays) Then
  5.     a = a + 1
  6.   End If
  7. Next i

La variable a est incrémenté si les nombres correspondent.

Reply

Marsh Posté le 07-03-2005 à 22:46:14    

Merci knakes pour le bout de code.
Je vais tester ca et je te tiens au jus.
Merci.
 
Cordialement

Reply

Marsh Posté le 08-03-2005 à 00:01:48    

Et buien je te remercie knakes pour ton aide.
J'ai legerement modifie ton code:
 
Set MaPlage = Worksheets("Fichier" ).Range("J2:J" & Cells(Rows.Count, "J" ).End(xlUp).Row)
On Error Resume Next
 
  TheDate = Now()
   
  For Each c In MaPlage
  If DatePart("ww", c.Value, , vbFirstFourDays) = DatePart("ww", TheDate, , vbFirstFourDays) Then
    NbContactSemaine = NbContactSemaine + 1
  End If
  Next
 
Ca roule pour le moment.
Merci encore de ton aide.
 
Cordialement

Reply

Marsh Posté le 08-03-2005 à 00:01:48   

Reply

Marsh Posté le 08-03-2005 à 01:19:37    

Petite astuce pour trouver la dernière ligne utilisée d'une feuille:
Cells.SpecialCells(xlLastCell).Row
Tu peux donc modifier ta ligne set comme suit:
Set MaPlage = Worksheets("Fichier" ).Range("J2:J" & Cells.SpecialCells(xlLastCell).Row)  


---------------
Si on vous donne une info qui marche, DITES-LE!!!! ------ Si vous trouvez seul, AUSSI, votre solution peut servir à d'autres! ------ Je dois la majorité de mes connaissances à mes erreurs!
Reply

Marsh Posté le 08-03-2005 à 10:38:55    

Merci Alaintech pour ta reponse.
Mais petite question:
est ce que si on a des cellules vides dans sa colonne, ta ligne ne va prendre l'une d'entre elle comme etant la derniere ligne de ma feuille?
 
Cordialement

Reply

Marsh Posté le 08-03-2005 à 10:39:11    

Vais quand meme tester ca.
A+

Reply

Marsh Posté le 08-03-2005 à 22:34:24    

Cells.SpecialCells(xlLastCell) donne la dernière cellule limitant toutes celles UTILISEE de la feuille.
Donc, la colonne sera la dernière contenant des données et la ligne, la dernière de la plus longue colonne.
 
Pour ma part, je travaille aussi avec des "for each ... in" et j'exclus du traitement les cellules vides.


---------------
Si on vous donne une info qui marche, DITES-LE!!!! ------ Si vous trouvez seul, AUSSI, votre solution peut servir à d'autres! ------ Je dois la majorité de mes connaissances à mes erreurs!
Reply

Marsh Posté le 09-03-2005 à 08:23:46    

Bonjour, je voulais avoir votre avis sur ca:
UNe fois les numeros de semaine trouve, je dois les mettres dans des cellules de excel, voici mon code:
 
  If Semaine = 8 Then
    Worksheets("Fichier Toulouse" ).Range("G4" ).Value = NbContactSemaine
  Else
  If Semaine = 9 Then
  Worksheets("Fichier Toulouse" ).Range("H4" ).Value = NbContactSemaine
  Else
  If Semaine = 10 Then
  Worksheets("Fichier Toulouse" ).Range("H8" ).Value = NbContactSemaine
  End If
  End If
  End If
 
Mon soucis est purement esthetique puisque je vais me retrouve avec 52 endIF( 52 semaine), je pensais pouvoir y arriver avec des "case" mais pour l'instant rien.
 
Si quelqu'un a une autre solution.
 
Merci

Reply

Marsh Posté le 09-03-2005 à 09:12:07    

bonjour,
With Worksheets("Fichier Toulouse" )
Select case
Case 8: .Range("G4" ).Value = NbContactSemaine  
Case 9: .Range("H4" ).Value = NbContactSemaine  
...
Case Else
End Select
End With
 
ou à la rigueur:
With Worksheets("Fichier Toulouse" )
If Semaine = 8 Then .Range("G4" ).Value = NbContactSemaine  
If Semaine = 9 Then .Range("H4" ).Value = NbContactSemaine  
End With
 
Mais la structure Select Case est de loin la meilleure car VBA ne lira que le Case qui l'intéresse.
Dans la 2ème solution VBA est obligé d'évaluer chaque condition...
 
A+

Reply

Marsh Posté le 09-03-2005 à 09:21:18    

Merci Galopin01.
JE vais tester ca et je vous tiens au jus.
 
Cordialement

Reply

Marsh Posté le 09-03-2005 à 10:35:57    

Bonjour,
j'ai teste et ca roule mais j'ai pb a la noix.
Quand j'effectue mon calcul sur la feuille ou je preleve mes infos ca marche par contre des que j'envoie le resultat sur une autre feuille, le resultat n'est pas le bon.
Voici mon code:
Sub ContactSemaine()
 
Dim MaPlage As Range
Dim TheDate
Dim Semaine
Dim a As Long
 
NbContactSemaine = 0
 
Set MaPlage = Worksheets("Fichier Toulouse" ).Range("K2:K" & Cells(Rows.Count, "K" ).End(xlUp).Row)
On Error Resume Next
 
  TheDate = Now()
  Semaine = DatePart("ww", TheDate, , vbFirstFourDays)
  For Each c In MaPlage
  If DatePart("ww", c.Value, , vbFirstFourDays) = Semaine Then
    NbContactSemaine = NbContactSemaine + 1
  End If
  Next
 
  Set MaPlage = Nothing
   
  With Worksheets("Bilan" )
    Select Case Semaine
 
        Case 1: .Range("C23" ).Value = NbContactSemaine
        Case 2: .Range("D23" ).Value = NbContactSemaine
        Case 3: .Range("E23" ).Value = NbContactSemaine
        Case 4: .Range("F23" ).Value = NbContactSemaine
        Case 5: .Range("G23" ).Value = NbContactSemaine
        Case 6: .Range("H23" ).Value = NbContactSemaine
        Case 7: .Range("I23" ).Value = NbContactSemaine
        Case 8: .Range("J23" ).Value = NbContactSemaine
        Case 9: .Range("K23" ).Value = NbContactSemaine
        Case 10: .Range("L23" ).Value = NbContactSemaine
        Case 11: .Range("M23" ).Value = NbContactSemaine
        Case 12: .Range("N23" ).Value = NbContactSemaine
        Case 13: .Range("O23" ).Value = NbContactSemaine
        Case 14: .Range("P23" ).Value = NbContactSemaine
        Case 15: .Range("Q23" ).Value = NbContactSemaine
        Case 16: .Range("C25" ).Value = NbContactSemaine
        Case 17: .Range("D25" ).Value = NbContactSemaine
        Case 18: .Range("E25" ).Value = NbContactSemaine
        Case 19: .Range("F25" ).Value = NbContactSemaine
        Case 20: .Range("G25" ).Value = NbContactSemaine
        Case 21: .Range("H25" ).Value = NbContactSemaine
        Case 22: .Range("I25" ).Value = NbContactSemaine
        Case 23: .Range("J25" ).Value = NbContactSemaine
        Case 24: .Range("K25" ).Value = NbContactSemaine
        Case 25: .Range("L25" ).Value = NbContactSemaine
        Case 26: .Range("M25" ).Value = NbContactSemaine
        Case 27: .Range("N25" ).Value = NbContactSemaine
        Case 28: .Range("O25" ).Value = NbContactSemaine
        Case 29: .Range("P25" ).Value = NbContactSemaine
        Case 30: .Range("Q25" ).Value = NbContactSemaine
        Case 31: .Range("C27" ).Value = NbContactSemaine
        Case 32: .Range("D27" ).Value = NbContactSemaine
        Case 33: .Range("E27" ).Value = NbContactSemaine
        Case 34: .Range("F27" ).Value = NbContactSemaine
        Case 35: .Range("G27" ).Value = NbContactSemaine
        Case 36: .Range("H27" ).Value = NbContactSemaine
        Case 37: .Range("I27" ).Value = NbContactSemaine
        Case 38: .Range("J27" ).Value = NbContactSemaine
        Case 39: .Range("K27" ).Value = NbContactSemaine
        Case 40: .Range("L27" ).Value = NbContactSemaine
        Case 41: .Range("M27" ).Value = NbContactSemaine
        Case 42: .Range("N27" ).Value = NbContactSemaine
        Case 43: .Range("O27" ).Value = NbContactSemaine
        Case 44: .Range("P27" ).Value = NbContactSemaine
        Case 45: .Range("Q27" ).Value = NbContactSemaine
        Case 46: .Range("C29" ).Value = NbContactSemaine
        Case 47: .Range("D29" ).Value = NbContactSemaine
        Case 48: .Range("E29" ).Value = NbContactSemaine
        Case 49: .Range("F29" ).Value = NbContactSemaine
        Case 50: .Range("G29" ).Value = NbContactSemaine
        Case 51: .Range("H29" ).Value = NbContactSemaine
        Case 52: .Range("I29" ).Value = NbContactSemaine
 
        Case Else
         
        End Select
    End With
   
End Sub
 
Je met mes resultat: With Worksheets("Bilan" )
Des que je les met dans cette feuille le resultat affiche n'est pas bon, j'ai des valeurs qui ne correspondent pas alors que si e me le resultat dans :With Worksheets("Feuille Toulouse" ), ben la j'ai pas de pb.
 
Si quelqu'un voit d'ou ca peut venir.
 
Merci

Reply

Marsh Posté le 09-03-2005 à 10:52:49    

Probablement que tu as écris ta macro dans u module de feuille.
Il faudrait la déplacer dans un module "Nouveau"

Reply

Marsh Posté le 09-03-2005 à 10:58:58    

J'ai pas bien saisie.
 
Ma macro se trouve dans:
VBAProject->Modules->Module1
 
Faut il que je deplace ma macro dans la feuille "Bilan"
 
Merci de votre aide.
Cordialement

Reply

Marsh Posté le 09-03-2005 à 11:01:27    

Non !

Reply

Marsh Posté le 09-03-2005 à 11:01:39    

Waiting...

Reply

Marsh Posté le 09-03-2005 à 11:11:09    

ok j'attends

Reply

Marsh Posté le 09-03-2005 à 11:24:35    

re :
D'abord tu pourrais réduire ton code de la manière suivante
With Worksheets("Bilan" )
Select Case Semaine
Case 1 To 15: .Cells(23, 2 + Semaine).Value = NbContactSemaine
Case 16 To 30: .Cells(25, Semaine - 13).Value = NbContactSemaine
Case 31 To 45: .Cells(27, Semaine - 28).Value = NbContactSemaine
Case 46 To 52: .Cells(29, Semaine - 43).Value = NbContactSemaine
End Select
End With
 
On y gagne un peu en lisibilité...
Mais sur le fond ça ne change rien à ton problème.
Tu pourrais peut-être me mettre un petit bout de ton classeur s'il n'est pas trop gros. (Zippé de préférence) à l’adresse suivante galopin01@laposte.net
Remplacer galopin01 par roger.mazurczak
 
je décroche jusqu'à 13h00

Reply

Marsh Posté le 09-03-2005 à 11:26:06    

Merci de ton aide galopin,
je t'envoie le code pour 13H
 
Merci

Reply

Marsh Posté le 09-03-2005 à 12:45:17    

Un peu lourd, le code avec case.
 
Le numéro de semaine peu servir d'index directement (quitte à ajouter ou soustraire une constante).


---------------
Si on vous donne une info qui marche, DITES-LE!!!! ------ Si vous trouvez seul, AUSSI, votre solution peut servir à d'autres! ------ Je dois la majorité de mes connaissances à mes erreurs!
Reply

Marsh Posté le 09-03-2005 à 13:06:53    

Galopin01, tu as du recevoir mon code.
 
J'espere que tu pourras m'aider.

Reply

Marsh Posté le 09-03-2005 à 13:17:02    

Waiting...

Reply

Marsh Posté le 09-03-2005 à 13:42:30    

oki galopin j'attends
J'espere que tu verras pkoi j'ai pas les memes resulats sur une feuille et sur l'autre.
 
Merci.
Cordialement.

Reply

Marsh Posté le 09-03-2005 à 13:54:55    

Bon,  
j'ai repris à zéro, réduit comme je t'ai indiqué.
Je ne vois pas d'erreur.
La macro réduite :

Code :
  1. Sub ContactSemaine()
  2. Dim a As Long, TheDate, Semaine, MaPlage As Range
  3. NbContactSemaine = 0
  4. Worksheets("Fichier Toulouse" ).Activate
  5. Set MaPlage = Worksheets("Fichier Toulouse" ).Range("K2:K" & Cells(Rows.Count, "K" ).End(xlUp).Row)
  6. On Error Resume Next
  7.   TheDate = Now()
  8.   Semaine = DatePart("ww", TheDate, , vbFirstFourDays)
  9.   For Each c In MaPlage
  10.   If DatePart("ww", c.Value, , vbFirstFourDays) = Semaine Then
  11.     NbContactSemaine = NbContactSemaine + 1
  12.   End If
  13.   Next
  14. Set MaPlage = Nothing
  15.  
  16. With Worksheets("Bilan" )
  17. Select Case Semaine
  18. Case 1 To 15: .Cells(23, 2 + Semaine).Value = NbContactSemaine
  19. Case 16 To 30: .Cells(25, Semaine - 13).Value = NbContactSemaine
  20. Case 31 To 45: .Cells(27, Semaine - 28).Value = NbContactSemaine
  21. Case 46 To 52: .Cells(29, Semaine - 43).Value = NbContactSemaine
  22. End Select
  23. End With
  24.  
  25. End Sub


Cette macro te renvoie le nombre de rendez-vous de la semaine en cours  
à l'endroit prévu. Il n'y a rien à y redire... Je pense que tu dois t'emmêler les pinceaux quelque part !
Qu'attendais-tu ?
Qu'il te remplisse tout le tableau bilan pour chaque semaine ?
Pour cela il faudrait faire une boucle sur TheDate car pour le moment tu ne travailles que sur :
TheDate = Now() 'Donc sur la semaine 10
CQFD ?
 
Maintenant s'il y en a qui ont des solutions au lieu de commentaires du genre peux mieux faire... Faut pas qu'ils se privent !
 
Tu me dis si tu veux que je gratte sur une boucle avec TheDate.
Cordialement.

Reply

Marsh Posté le 09-03-2005 à 14:02:53    

Merci de ta reponse Galopin.
CE que je veux c'est que TheDate ne travaille que sur la semaine 10. Le calcul se fait par r apport a la semaine en cour.
Mon pb est que si je lance la macro a l'heure actuelle avec des dates dans ma feuille fichier toulouse correspondant a la semaine en cour et bien je me retrouve avec la valeur 0 dans la cellule S10(L23) de ma feuille bilan. Cela fait pareil avec les macros de calcul au mois.
C'est ca mon pb.
 
Je vois pas pkoi les resultats sont pas bon surtout que si tu met les resultats sur la feuille Fichier toulouse et bien la ca marche.
Tu vois pas un truc?
 
Cordialement

Reply

Marsh Posté le 09-03-2005 à 14:07:14    

Heu attends je regarde un truc.
JE viens de faire un copier coller de ton code et la ca marche normalement.
Je capte pas pkoi.
Je vais continuer mes tests et je te fais signe pour te dire si ca roule ou pas.
 
Merci de ton aide Galopin sans toi ppfffffffffffff je serais encore entrain de trimer.
 
Cordialement

Reply

Marsh Posté le 09-03-2005 à 14:18:12    

Bon alors jusque ici les contact semaine et rdv semain fonctionne nickel, je passe au mois parce que la ......

Reply

Marsh Posté le 09-03-2005 à 14:32:30    

C'est encore plus simple : Pour ContactMois, tu remplaces le  
With Worksheets("Bilan" )  
Select Case... End With par :
 
Worksheets("Bilan" ).Cells(32, Mois + 2).Value = NbContactMois
Ok ?


Message édité par galopin01 le 09-03-2005 à 14:33:29
Reply

Marsh Posté le 09-03-2005 à 14:33:14    

Bon ben j'ai bien un pb avec les mois.
voici mon code:
Sub ContactMois()
 
Dim a As Long, Mois, MaPlage As Range
NbContactMois = 0
Set MaPlage = Worksheets("Fichier Toulouse" ).Range("K2:K" & Cells(Rows.Count, "K" ).End(xlUp).Row)
On Error Resume Next
   
  Mois = Month(Now())
   
  For Each c In MaPlage
    If IsDate(c.Value) Then
      If Month(c.Value2) = CInt(Mois) Then
          NbContactMois = NbContactMois + 1
      End If
    End If
  Next
 
  Set MaPlage = Nothing
   
    With Worksheets("Bilan" )
    Select Case Mois
    Case 1 To 12: .Cells(32, 2 + Mois).Value = NbContactMois
    End Select
    End With
End Sub
 
Si je me met en fevrier, il m'affiche un resultat de 14 au lieu de 22.
 
Je vois pas pas pkoi
Quelqu'un a une idee.
Galopin??
 
Cordialement

Reply

Marsh Posté le 09-03-2005 à 14:35:52    

Comment tu fais pour te mettre en février ?


Message édité par galopin01 le 09-03-2005 à 14:36:47
Reply

Marsh Posté le 09-03-2005 à 14:37:54    

Ben je modifie la date sous windows.

Reply

Marsh Posté le 09-03-2005 à 14:38:21    

ca marche qd je fais comme ca pour les macros concernant les semaines

Reply

Marsh Posté le 09-03-2005 à 14:48:55    

moi, je ne touche pas à windows, j'écris :
Mois = 2
et ça marche !
 
PS : remplace toute les lignes With ...SElect...end With par :
Worksheets("Bilan" ).Cells(32, Mois + 2).Value = NbContactMois
Ok ?

Reply

Marsh Posté le 09-03-2005 à 14:53:23    

Ben ca me fait pareil, j'ai un resultat egal a 14 au lieu de 22.
Je comprend pas.
je te redonne le code:
Sub ContactMois()
 
Dim a As Long, Mois, MaPlage As Range
NbContactMois = 0
Set MaPlage = Worksheets("Fichier Toulouse" ).Range("K2:K" & Cells(Rows.Count, "K" ).End(xlUp).Row)
On Error Resume Next
   
  Mois = 2 'Month(Now())
   
  For Each c In MaPlage
    If IsDate(c.Value) Then
      If Month(c.Value2) = CInt(Mois) Then
          NbContactMois = NbContactMois + 1
      End If
    End If
  Next
 
  Set MaPlage = Nothing
   
Worksheets("Bilan" ).Cells(32, Mois + 2).Value = NbContactMois
 
End Sub
 
JE comprend vraiment pas

Reply

Marsh Posté le    

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed