[VBA] Identifier date la + proche de la fin de mois

Identifier date la + proche de la fin de mois [VBA] - VB/VBA/VBS - Programmation

Marsh Posté le 27-05-2006 à 13:42:59    

[size=1][\"Black\][/size][size=0]Bonjour à tous,
 

 


Voila, je cherche un code VBA qui identifie parmis un liste de date, celle qui se rapporche le plus de la fin du mois.
 
voici comment se compose le fichier Excel :
 

 


col A                 |         col B      
 
BBBBBBB    |     29/05/06      
 
BBBBBBB    |     30/05/06    
 
BBBBBBB    |     01/06/06    
 
PPPPPP1    |     26/05/06
 
PPPPPP1    |     02/06/06    
 
xyzd253      |     22/05/06
 
xyzd253      |     05/06/06      
 
AAAAAAA    |     30/05/06      
 
AAAAAAA    |     31/05/06      
 
AAAAAAA    |     01/06/06      
 

 


Comme vous pouvez le voir, en colonne A il y a plusieurs \"Codes\"
differents, je cherche donc à identifier la date pour chaque \"Code\" la
plus proche (en nombre de jour ouvrés) de la date de fin de mois (ici
:31/05/2006) et afficher en colonne C le resultat.
 
Le jour le plus proche donc que ce soit avant ou apres le dernier jour de fin de mois.
 
En gros si il y a le choix entre le 25/05/06 et le 02/06/06 et que la
date butoir est :31/05/06, la macro choisira le 02/06/2006
 

 

 


En language VBA je pensais faire :
 
tant que (monCode) est identique
 
   alors fait le calcul \"maDate\"
 
Sinon passe a la ligne suivante
 

 


maDate serai une procedure VBA qui calcule le jour le plus proche de fin de mois
 
(monCode) serai une variable qui stockerai le code actuel.
 
genre: monCode = Activecell.text
 

 


A la fin j'aurai un truc comme ça :
 

 


col A                  |     col B              |   col C
 
BBBBBBB     |    29/05/06   |    
 
BBBBBBB     |    30/05/06   |   correct
 
BBBBBBB     |    01/06/06   |  
 
PPPPPP1     |    26/05/06   |
 
PPPPPP1     |    02/06/06   |   correct
 
xyzd253       |    22/05/06   |
 
xyzd253       |    05/06/06   |   correct
 
AAAAAAA     |    30/05/06   |    
 
AAAAAAA     |    31/05/06   |   correct
 
AAAAAAA     |    01/06/06   |    
 

 


Vuus pensez que c'est possible ?
 

 

 

 


Merci a tous ceux qui pourront m'aider, et n'hesitez pas à me demander si je n'ai pas été assez explicite.
 
 [/size][/\"Black\]

Reply

Marsh Posté le 27-05-2006 à 13:42:59   

Reply

Marsh Posté le 28-05-2006 à 15:37:15    

En partant de l'hypothèse (réaliste ?) que tes données sont dans une feuille Excel, tu dois pouvoir t'appuyer sur des fonctions qui sont fournies dans le ToolPack d'analyse.
 
Je n'ai qu'une version US d'excel, donc te laisse trouver l'équivalent Français au besoin.
Menu Tools / Add-ins... - Cocher Analysis Toolpack et Analysis Toolpack VBA
 
La fonction intéressante s'appelle NetWorkDays en anglais (NbrJoursOuvres en français si je me souviens bien).
Elle calcule le nombre de jours ouvrés entre deux dates, en tenant compte d'une liste de jours fériés passés en 3è paramètre.
 
 
Juste pour le sport  ;) et même si ce n'est certainement pas la méthode la plus économique en ressources, tu peux faire ce que tu cherches uniquement sur base de formules, sans code :
 
Je considère que la ligne 1 est une ligne d'entete, et ci-dessous les formules pour la ligne 2 (identiques pour les autres lignes) :
- Col A : Les codes (comme dans ton exemple, on considère la liste triée sur le code)
- Col B : Les dates
- Col C : Numéro de la 1ère ligne pour cette valeur de code :

=IF(A2=A1;C1;ROW())


- Col D :Numéro de la dernière ligne pour cette valeur de code :

=IF(A2=A3;D3;ROW())


- Col E : Ecart en nombre de jour ouvrés à la date de fin de mois

=ABS(NETWORKDAYS(B2;DateFinMois;Feries))


- Col F : Colonne "statut" (ce que tu cherches !)

=IF(E2=MIN(OFFSET($E$1;C2-1;0;D2-C2+1));"Correct";"" )


 
 
Si tu préfères travailler à base de VBA (ce qui est sans doute plus efficace, et en tout cas ne demande pas de définir de formules dans ta feuille), tu peux aussi invoquer la méthode en question dans du code VBA pour récupérer l'écart en nombre de jours pour une ligne.
Par exemple :

Code :
  1. Sub JustDoIt()
  2.    
  3.     Dim DateFinMois As Date
  4.     Dim Ferie As Range
  5.    
  6.     DateFinMois = Range("DateFinMois" ).Value
  7.     Set Ferie = Range("Feries" )
  8.    
  9.     MsgBox Application.Run("ATPVBAEN.XLA!networkdays", ActiveCell.EntireRow.Cells(1, 2), DateFinMois, Ferie)
  10. End Sub


 
Attention, en version française, l'add-in doit s'appeler ATPVBAFR.XLA
Le parcours de la liste pour définir la ligne qui porte le minimum pour une valeur de code est de l'algo "standard".
Je te laisse faire ;)
 
Bon courage,
Bidgii

Reply

Sujets relatifs:

Leave a Replay

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