Vba renvoyer n° de semaine

A

Arpette

XLDnaute Impliqué
Bonsoir le Forum,

Je souhaiterais renseigner les numeros de semaine d'un mois donné ex:

A1= Juillet 2010

Mon souhait

B1 = 26, C1 = 27, D1 = 28, E1 = 29, F1 = 30

Merci pour votre aide.
 
Trier par date Trier par votes
Gael

Gael

XLDnaute Barbatruc
Re : Vba renvoyer n° de semaine

Bonsoir Arpette, bonsoir à tous,

Un essai en formules.

@+

Gael
 

Pièces jointes

  • Semaines.xls
    13.5 KB · Affichages: 76
  • Semaines.xls
    13.5 KB · Affichages: 77
  • Semaines.xls
    13.5 KB · Affichages: 74
Vote positif 0 Vote négatif
A

Arpette

XLDnaute Impliqué
Re : Vba renvoyer n° de semaine

CMoa à dit:
Bonjour Arpette
essaye ceci en B:
Code: 
=NO.SEMAINE(A1;2)+1
Dans C ceci à tirer vers la droite:
Code: 
=B1+1
@+
Cliquez pour agrandir...
Bonsoir et merci à tous les deux de m'avoir répondu. J'avais fais ça en VBA du genre :
Cells(1,2)=num_semaine
Cells(1,3)=num_semaine+1 etc...
Le problème est dans le cas où il y a 53 semaines comme le 01/01/2010 ça donne 53, 54, 55 Etc..
Je ne sais pas si Excel connait les semaines en mode Européen avec 53 semaines.
Merci de votre aide.
 
Vote positif 0 Vote négatif
G

Guest

Guest
Re : Vba renvoyer n° de semaine

Bonsoir le fil,

Numéro de semaine iso en vba:

Code: 
NumSemaineIso=DatePart("ww", [COLOR=red]LaDate[/COLOR], vbMonday, vbFirstFourDays)

Où laDate est la date on on veut le numéro de semaine

A+
 
Vote positif 0 Vote négatif
A

Arpette

XLDnaute Impliqué
Re : Vba renvoyer n° de semaine

Hasco à dit:
Bonsoir le fil,

Numéro de semaine iso en vba:

Code: 
NumSemaineIso=DatePart("ww", [COLOR=red]LaDate[/COLOR], vbMonday, vbFirstFourDays)

Où laDate est la date on on veut le numéro de semaine

A+
Cliquez pour agrandir...
Bonsoir Hasco, merci pour ta réponse ça renvoie bien la première semaine de Juillet 2010 (26) B1 , mais comment je fais pour renvoyer (27) en C2.
Merci de votre aide.
 
Vote positif 0 Vote négatif
G

Guest

Guest
Re : Vba renvoyer n° de semaine

Re,
Exemple:
Code: 
Sub Truc()
 Dim DateDepart As Date: DateDepart = DateValue("1/7/2010")
 Dim c As Range
 For Each c In Range("B1:F1")
    c = DatePart("ww", DateDepart, vbMonday, vbFirstFourDays)
    DateDepart = DateDepart + 7 'Incrémenter la date de 7 jours (1 semaine)
 Next
End Sub

A+
 
Vote positif 0 Vote négatif
A

Arpette

XLDnaute Impliqué
Re : Vba renvoyer n° de semaine

Hasco à dit:
Re,
Exemple:
Code: 
Sub Truc()
 Dim DateDepart As Date: DateDepart = DateValue("1/7/2010")
 Dim c As Range
 For Each c In Range("B1:F1")
    c = DatePart("ww", DateDepart, vbMonday, vbFirstFourDays)
    DateDepart = DateDepart + 7 'Incrémenter la date de 7 jours (1 semaine)
 Next
End Sub

A+
Cliquez pour agrandir...
Re,
merci pour ta réponse ça doit marcher mais je n'arrive pas à l'adapter à ma macro. Je te joints le fichier pour voire où est le problème. Merci d'avance.
 

Pièces jointes

  • Arpette.zip
    20.3 KB · Affichages: 35
  • Arpette.zip
    20.3 KB · Affichages: 34
  • Arpette.zip
    20.3 KB · Affichages: 38
Vote positif 0 Vote négatif
G

Guest

Guest
Re : Vba renvoyer n° de semaine

Bonjour Arpette, le forum,

Vois si cette nouvelle macro WorkBook_Open te convient:

Code: 
Private Sub Workbook_Open()
    Dim c As Range
    Dim DateDepart As Date
    'Date départ au 1er du mois
    DateDepart = DateSerial(Year(Date), Month(Date), 1)
    
    'Mettre une condition ici n'est pas absolument nécessaire
    's'il y avait une vérification à faire ce serait peut-être
    'de controler si la date affichée correspond au mois en cours
    If IsEmpty(Sheets("Récap_Mensuelle").Cells(4, 1)) Then
        Sheets("Récap_Mensuelle").Cells(4, 1) = "MOIS DE " & UCase(Format(DateDepart, " mmmm yyyy"))
    End If
    Sheets("Relevé_Hebdo").Select
    Worksheets("Relevé_Hebdo").Unprotect
   
    Cells(1, 1) = "Mois de " & UCase(Format(DateDepart, "mmmm"))
    'Attention nous avons à faire à des cellules fusionnées!
    'il faut donc alimenter 1 cellule sur 2 à partir de C1
    For Each c In Range("C1,E1,G1,I1,K1")
        c = "sem " & DatePart("ww", DateDepart, vbMonday, vbFirstFourDays)
        DateDepart = DateDepart + 7    'Incrémenter la date de 7 jours (1 semaine)
    Next
    Worksheets("Relevé_Hebdo").Protect
End Sub

A+
 
Vote positif 0 Vote négatif
C

CMoa

XLDnaute Occasionnel
Re : Vba renvoyer n° de semaine

Bonjour Arpette;Hasco et le fil
Une autre proposition en partant de la macro fournie par Hasco:
Code: 
Option Explicit

Private Sub Workbook_Open()

Sheets("Récap_Mensuelle").Select
    If Cells(4, 1) = Empty Then

Dim Mois As String
Dim Année As String
Dim Titre As String
Dim Récap_Mensuelle As String
Dim Relevé_Hebdo As String
Dim semaine As String
Dim Sme As String
Dim DateDepart As Date: DateDepart = DateValue("1/7/2010")
Dim c As Range
Sheets("Récap_Mensuelle").Select

Mois = Format(Now, "mmmm")
Année = Format(Now, "yyyy")

Titre = "MOIS DE" & "  " & Mois & "  " & Année
Cells(4, 1) = UCase(Titre)
Sheets("Relevé_Hebdo").Select
Worksheets("Relevé_Hebdo").Unprotect
Mois = Format(Now, "mmmm")
Année = Format(Now, "yyyy")
Titre = Mois & "  " & Année
Cells(1, 1) = UCase(Titre)
'Worksheets("Relevé_Hebdo").Protect
    End If

 Worksheets("Relevé_Hebdo").Activate
   Range("B1") = DatePart("ww", DateDepart, vbMonday, vbFirstFourDays)
   Range("C1") = DatePart("ww", DateDepart + 7, vbMonday, vbFirstFourDays)
   Range("E1") = DatePart("ww", DateDepart + 14, vbMonday, vbFirstFourDays)
   Range("G1") = DatePart("ww", DateDepart + 21, vbMonday, vbFirstFourDays)
   Range("I1") = DatePart("ww", DateDepart + 28, vbMonday, vbFirstFourDays)
    
End Sub
En effet à cause des cellules fusionnées;il faut identifier les cellules à alimenter.
@+
 
Vote positif 0 Vote négatif
A

Arpette

XLDnaute Impliqué
Re : Vba renvoyer n° de semaine

CMoa à dit:
Bonjour Arpette;Hasco et le fil
Une autre proposition en partant de la macro fournie par Hasco:
Code: 
Option Explicit

Private Sub Workbook_Open()

Sheets("Récap_Mensuelle").Select
    If Cells(4, 1) = Empty Then

Dim Mois As String
Dim Année As String
Dim Titre As String
Dim Récap_Mensuelle As String
Dim Relevé_Hebdo As String
Dim semaine As String
Dim Sme As String
Dim DateDepart As Date: DateDepart = DateValue("1/7/2010")
Dim c As Range
Sheets("Récap_Mensuelle").Select

Mois = Format(Now, "mmmm")
Année = Format(Now, "yyyy")

Titre = "MOIS DE" & "  " & Mois & "  " & Année
Cells(4, 1) = UCase(Titre)
Sheets("Relevé_Hebdo").Select
Worksheets("Relevé_Hebdo").Unprotect
Mois = Format(Now, "mmmm")
Année = Format(Now, "yyyy")
Titre = Mois & "  " & Année
Cells(1, 1) = UCase(Titre)
'Worksheets("Relevé_Hebdo").Protect
    End If

 Worksheets("Relevé_Hebdo").Activate
   Range("B1") = DatePart("ww", DateDepart, vbMonday, vbFirstFourDays)
   Range("C1") = DatePart("ww", DateDepart + 7, vbMonday, vbFirstFourDays)
   Range("E1") = DatePart("ww", DateDepart + 14, vbMonday, vbFirstFourDays)
   Range("G1") = DatePart("ww", DateDepart + 21, vbMonday, vbFirstFourDays)
   Range("I1") = DatePart("ww", DateDepart + 28, vbMonday, vbFirstFourDays)
    
End Sub
En effet à cause des cellules fusionnées;il faut identifier les cellules à alimenter.
@+
Cliquez pour agrandir...

Bonsoir et merci à tous les deux. Les deux macro fonctionnent à merveille. Le seul problème est que dans celle Hasco ça renvoie le mois de septembre en A1et dans celle de Cmoa le début de mois est renseigné dans les variables. Ce fichier est mis à jour tous les mois et prend le mois du système.
Merci encore à tous les deux pour votre aide.
 
Vote positif 0 Vote négatif
A

Arpette

XLDnaute Impliqué
Re : Vba renvoyer n° de semaine

Arpette à dit:
Bonsoir et merci à tous les deux. Les deux macro fonctionnent à merveille. Le seul problème est que dans celle Hasco ça renvoie le mois de septembre en A1et dans celle de Cmoa le début de mois est renseigné dans les variables. Ce fichier est mis à jour tous les mois et prend le mois du système.
Merci encore à tous les deux pour votre aide.
Cliquez pour agrandir...

Re, j'ai trouvé la solution en mettant en variable

Dim DateDepart As Date: DateDepart = Month(Date)
je vous joints la macro. Il me reste le problème de la semaine 53
j'ai une fonction qui tient compte de la semaine 53, mais je ne sais pas où la placer.

Macro

Private Sub Workbook_Open()

Sheets("Récap_Mensuelle").Select
If Cells(4, 1) = Empty Then

Dim Mois As String
Dim Année As String
Dim Titre As String
Dim Récap_Mensuelle As String
Dim Relevé_Hebdo As String
Dim semaine As String
Dim Sme As String
Dim c As Range
Dim DateDepart As Date: DateDepart = Month(Date)
Sheets("Récap_Mensuelle").Select

Mois = Format(Now, "mmmm")
Année = Format(Now, "yyyy")

Titre = "MOIS DE" & " " & Mois & " " & Année
Cells(4, 1) = UCase(Titre)

Sheets("Relevé_Hebdo").Select

Worksheets("Relevé_Hebdo").Unprotect

Mois = Format(Now, "mmmm")
Année = Format(Now, "yyyy")

Titre = "MOIS DE" & " " & Mois & " " & Année
Cells(1, 1) = UCase(Titre)

'Cells(1, 1) = "Mois de " & UCase(Format(DateDepart, "mmmm"))
'Attention nous avons à faire à des cellules fusionnées!
'il faut donc alimenter 1 cellule sur 2 à partir de C1
For Each c In Range("C1,E1,G1,I1,K1")
c = "Sem " & DatePart("ww", DateDepart, vbMonday, vbFirstFourDays)
DateDepart = DateDepart + 7 'Incrémenter la date de 7 jours (1 semaine)
Next
Worksheets("Relevé_Hebdo").Protect
End If

End Sub
La funcion

Function CLSC(Dates As Date) As Integer
Dim semaine As Integer
semaine = Int((Dates - DateSerial(Year(Dates), 1, 1) + _
((Weekday(DateSerial(Year(Dates), 1, 1)) + 1) _
Mod 7) - 3) / 7) + 1
If semaine = 0 Then
semaine = CLSC(DateSerial(Year(Dates) - 1, 12, 31))
ElseIf semaine = 53 And (Weekday(DateSerial(Year(Dates), 12, 31)) - 1) _
Mod 7 <= 3 Then
semaine = 1
End If
CLSC = semaine
End Function
 
Dernière édition:
Vote positif 0 Vote négatif
G

Guest

Guest
Re : Vba renvoyer n° de semaine

Re,

Euh!... comprend pas trop, la fonction que je t'ai donnée:

DatePart("ww", DateDepart, vbMonday, vbFirstFourDays)

tient compte de la semaine 53 (par exemple en 2009)

A+
 
Dernière modification par un modérateur:
Vote positif 0 Vote négatif

Discussions similaires

chaelie2015
  • Résolu(e)
XL 2013 (RESOLU) Nombre de jours selon l'année et le mois
Réponses
4
Affichages
441
ChTi160
ChTi160
chaelie2015
  • Résolu(e)
Autres Pointage par semaine qui (du lundi au Dimanche)
Réponses
11
Affichages
803
chaelie2015
chaelie2015
M
  • Question
XL 2016 Impression d'un rapport PDF depuis une URL avec VBA
Réponses
3
Affichages
571
mrcooll
M
Modeste geedee
élucubrations ??
Réponses
6
Affichages
620
Cousinhub
Cousinhub
vgendron
  • Question
Power Query Premiers Pas Power Query, combiner tableaux provenant de différents onglets
Réponses
8
Affichages
884
vgendron
vgendron
R
  • Question
XL 2010 VBA : consolidation
Réponses
2
Affichages
733
Rousseau Benoit
R
K
  • Question
Microsoft 365 [VBA] [Résolue] changer les type de donnée de la cellule
Réponses
4
Affichages
860
Hasco
Hasco
M
  • Question
Microsoft 365 Evolution macro - VBA - Copier/coller en fonction d'une ligne
Réponses
6
Affichages
1 K
melinavy
M
M
  • Résolu(e)
Microsoft 365 Création "auto" de tableau
Réponses
12
Affichages
1 K
maxime45
M
P
  • Résolu(e)
XL 2013 VBA problème de tri entre versions d'Excel
Réponses
2
Affichages
1 K
Ptrs32
P

Membres actuellement en ligne

20 membres et 171 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 556
Messages
2 089 580
Membres
104 215
dernier inscrit
Jean Michl