rechercher une date sous excel - VB/VBA/VBS - Programmation
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 ?
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
Marsh Posté le 07-03-2005 à 12:04:47
Bon voilà le code :
Code :
|
(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 . 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 ...
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, .......
Marsh Posté le 07-03-2005 à 12:34:38
Quel est ton code pour transformer une date en numéro de semaine ?
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
Marsh Posté le 07-03-2005 à 17:21:14
Donc voila un bout du programme
Code :
|
La variable a est incrémenté si les nombres correspondent.
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
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
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)
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
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.
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
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+
Marsh Posté le 09-03-2005 à 09:21:18
Merci Galopin01.
JE vais tester ca et je vous tiens au jus.
Cordialement
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
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"
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
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) à ladresse suivante galopin01@laposte.net
Remplacer galopin01 par roger.mazurczak
je décroche jusqu'à 13h00
Marsh Posté le 09-03-2005 à 11:26:06
Merci de ton aide galopin,
je t'envoie le code pour 13H
Merci
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).
Marsh Posté le 09-03-2005 à 13:06:53
Galopin01, tu as du recevoir mon code.
J'espere que tu pourras m'aider.
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.
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 :
|
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.
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
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
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 ......
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 ?
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
Marsh Posté le 09-03-2005 à 14:35:52
Comment tu fais pour te mettre en février ?
Marsh Posté le 09-03-2005 à 14:38:21
ca marche qd je fais comme ca pour les macros concernant les semaines
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 ?
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
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.