calcul semaine par macro

[matt31]

Bonjour

je voudrais savoir comment faire pour calculer le numéro de la semaine en fonction d'une date donnée mais uniquement par une macro.

En fait, j'ai plusieurs fichiers liés les uns au autres.
Le fichier B se remplie automatiquement par une macro du fichier A et en fonction de conditions sur ce dernier. Les dates sont donc copiées depuis le fichier A.
Par contre, la macro du fichier A efface aussi les lignes copiées sur le fichier B lorsque la condition de départ n'est plus remplie.
Si je mets une formule sur le fichier B, il fait que je la copie initialement sur toutes les cellules d'une colonne car elle sera effacée dès que la ligne sera supprimée en même temps que la ligne.
A l'inverse une macro ne s'activerait automatiquement que lorsque (par exemple) il y a une date de renseignée en colonne E pour indiquer la semaine en colonne F.
Difficile de mettre un exemple car tous les fichiers sont liés entre eux.

Merci pour votre aide

 

[jp14]

Re : calcul semaine par macro

Bonjour

Pour trouver une semaine on utilise la fonction DatePart.
Il faut lire l'aide pour trouver le bon paramètre en fonction du mode calcul.

JP

 

[matt31]

Re : calcul semaine par macro

j'ai bon lire des posts et des posts, je ne trouve pas comment résoudre mon problème.

A l'ouverture de mon fichier, j'aurais souhaité qu'en fonction de la date en colonne A, cela me donne le numéro de la semaine en colonne B.
Pas par une formule ou fonction car je devrais copier celle-ci sur des milliers de cellules mais par une macro.

Je vais continuer de chercher mais si quelqu'un a entre temps une solution, je suis preneur...😀

 

[pierrejean]

Re : calcul semaine par macro

Bonjour matt31

Salut jp14

matt31 ton problème est difficile à saisir
Peux-tu creer un ou 2 fichiers exemples (quelques lignes suffisent) ?
En régle générale les fichiers sont très bavards

 

[matt31]

Re : calcul semaine par macro

voilà c'est fait, mais c'est tout bête.
Ma date est en colonne A, en B je veux le numéro de semaine correspondante.

Par contre, pas en passant par une formule cela ne peut pas fonctionner car les lignes sont supprimées de ce fichier dès qu'elles sont mises en jour sur le fichier de base. Du coup ma formule serait supprimée systématiquement or ce fichier se remplit automatiquement.

J'espère être clair

 

[JCGL]

Re : calcul semaine par macro

Bonjour à tous,



Voici un florilège de contributions sur XLD :

Function NOSEM(D As Date) As Long 'Renauder sur XLD
   D = Int(D)
   NOSEM = DateSerial(Year(D + (8 - Weekday(D)) Mod 7 - 3), 1, 1)
   NOSEM = ((D - NOSEM - 3 + (Weekday(NOSEM) + 1) Mod 7)) \ 7 + 1
End Function

Public Function NumSemaine(D As Date) 'Renauder sur XLD
Dim t As Long
  t = DateSerial(Year(D + (8 - Weekday(D)) Mod 7 - 3), 1, 1)
  NumSemaine = ((D - t - 3 + (Weekday(t) + 1) Mod 7)) \ 7 + 1
End Function

Public Function Nodesem(D As Date) ' (appel avec D="jj/mm/aaaa") 'Michel_M sur XLD
'calcul 1'jour de l'année: 1=Lundi...7=Dimanche
A = Year(D): M = 1: J = 1: If M < 3 Then M = M + 12: A = A - 1
X = J + A + (M * 2) + Int((M + 1) * 3 / 5) + Int(A / 4) - 1: NoDuPremJr = (X Mod 7) + 1
'calcul jours écoulés entre le 1'janv à ce jour (ajouter le NoDuPremJr)
Dim D1 As Date, D2 As Date
D1 = 1 & " " & 1 & " " & Year(D): D2 = Day(D) & " " & Month(D) & " " & Year(D)
NbrDeJrs = DateDiff("d", D1, D2) + NoDuPremJr
NbrDeSem = NbrDeJrs \ 7: If NbrDeJrs / 7 > NbrDeSem Then NbrDeSem = NbrDeSem + 1 'test+fiable que Cint()
Nodesem = NbrDeSem
End Function

Function NumSem(DateJour As Date) As Long 'tototiti2008 sur XLD
'Calcule le numéro de semaine d'une année suivant cette norme :
'la semaine du 1er janvier n'est la semaine 1 que si elle contient au moins 4 jours
'la semaine commence le lundi
Dim PremJanv As Date, PremJanvSuiv As Date, DateSem1 As Date, DateSem1Suiv As Date
    PremJanv = DateSerial(Year(DateJour), 1, 1)
    PremJanvSuiv = DateSerial(Year(DateJour) + 1, 1, 1)
    If Weekday(PremJanv, vbMonday) <= 4 Then
        DateSem1 = PremJanv - Weekday(PremJanv, vbMonday) + 1
    Else
        DateSem1 = PremJanv + 8 - Weekday(PremJanv, vbMonday)
    End If
    If Weekday(PremJanvSuiv, vbMonday) <= 4 Then
        DateSem1Suiv = PremJanvSuiv - Weekday(PremJanvSuiv, vbMonday) + 1
    Else
        DateSem1Suiv = PremJanvSuiv + 8 - Weekday(PremJanvSuiv, vbMonday)
    End If
    NumSem = 1 + (DateJour - DateSem1) \ 7
    If DateSem1 > DateJour Then
        NumSem = NumSem(PremJanv - 1)
    ElseIf DateJour >= DateSem1Suiv Then
        NumSem = NumSem(PremJanvSuiv)
    End If
End Function

Function CurW(D As Date) As Long ' Roger sur XLD
       CurW = DatePart("WW", D, vbMonday, vbFirstFourDays)
End Function

Function JMH(D As Date) 'Proposé par Jean-Marcel sur XLD
 JMH = DatePart("ww", D, vbMonday, vbFirstFourDays)
End Function

A + à tous

 

[pierrejean]

Re : calcul semaine par macro

Re

Vois si tu peux t'inspirer de ceci

Edit: Salut JC 🙂 🙂

 

[matt31]

Re : calcul semaine par macro

merci
il faut donc créer une fonction pour ce calcul
Mais est-il possible d'y faire appel pour que le calcul se fasse automatiquement à l'ouverture du fichier.
S'il y a une date en A alors la cellule B correspondante indique le numéro de semaine, s'il n'y a pas de date, elle affiche rien et sur toute la feuille?

Encore merci pour l'aide

 

[pierrejean]

Re : calcul semaine par macro

Re

Voila
Voir macro dans thisworkbook

 

[JCGL]

Re : calcul semaine par macro

Bonjour à tous,

Juste pour saluer PJ que j'avais zappé...

A bientôt l'ami...

A + à tous

 

[matt31]

Re : calcul semaine par macro

j'ai un message d'erreur suivant :

Erreur d'exécution '1004':
la méthode 'Rows' de l'objet '_Application' a échoué

sur la ligne
For n = 1 To Range("A" & Application.Rows.Count).End(xlUp).Row


et encore une fois merci pour l'aide apportée

 

[JCGL]

Re : calcul semaine par macro

Bonjour à tous,

Matt31 : Merci de commencer tes messages par un Bonjour...

As-tu testé le fichier de PJ ?
Chez moi il fonctionne sans erreur.

As-tu des données en A ?

A + à tous

 

[matt31]

Re : calcul semaine par macro

bonsoir et merci pour votre aide. Mais également pardon pour l'oublie sur le message précédent.

Oui j'ai testé la pj de PJ et l'erreur est signalé sur ce fichier.
Oui il y a des données en A.
L'erreur vient dès l'ouverture du fichier de PJ. Je n'y modifie rien du tout.

Encore merci