XL 2021 Comment lister mardi et mercredi d'une année VBA

Créer une discussion
Répondre

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
Trier par date Trier par votes
Désolé c'est pas très clair, voici le rendu image qui irai bien.
Faudrait que les dates démarra en A3, et que les lignes total et total heure soit automatique vba
entre chaque mois comme la photo.
Jusque en bas.
En espérant que se soit plus compréhensif en visu
Merci beaucoup

Le plus compliqué c'est de définir chaque plages de cellules et de les additionner entre 2 mois, et en le faisant proprement
 

Pièces jointes

  • mon idée.jpg
    mon idée.jpg
    136.2 KB · Affichages: 15
Dernière édition:
Vote positif 0 Vote négatif
Je comprends que les heurs travaillées sont entrées manueellement.

La nouvelle macro qui crée 2 MFC :
VB: 
Private Sub Worksheet_Calculate()
Dim efface As Boolean, dat&, i&, a(1 To 118, 1 To 2) '118 = 2 x 53 semaines + 12
efface = Year(Date) <> Year(CStr([Jour])) 'test pour le début de l'année
Application.ScreenUpdating = False
[A3].Resize(UBound(a), 2).NumberFormat = "General" 'RAZ
For dat = DateSerial([A1], 1, 1) To DateSerial([A1], 12, 31)
    If Weekday(dat) = 3 Then
        i = i + 1
        a(i, 1) = dat
        If efface Then a(i, 2) = Empty Else a(i, 2) = Cells(i + 2, 2)
        Cells(i + 2, 1).NumberFormat = """Mardi"" * dd/mm/yyyy" 'format Date personnalisé
    ElseIf Weekday(dat) = 4 Then
        i = i + 1
        a(i, 1) = dat
        If efface Then a(i, 2) = Empty Else a(i, 2) = Cells(i + 2, 2)
        Cells(i + 2, 1).NumberFormat = """Mercredi"" * dd/mm/yyyy" 'format Date personnalisé
    End If
    If Month(dat) < Month(dat + 1) Then
        i = i + 1 'saut de ligne
        a(i, 2) = "=SUBTOTAL(9,B$3:B" & i + 1 & ")"
        Cells(i + 2, 2).NumberFormat = """Total ""0"
    End If
Next dat
a(i + 1, 2) = "=SUBTOTAL(9,B$3:B" & i + 2 & ")" 'dernier Total
Cells(i + 3, 2).NumberFormat = """Total ""0"
Application.EnableEvents = False 'désactive les évènements
With [A3].Resize(UBound(a))
    .Resize(, 2).FormatConditions.Delete 'RAZ
    ThisWorkbook.Names.Add "Jour", Date 'nom défini
    ThisWorkbook.Names.Add "Mini", "=MIN(ABS(" & .Address & "-Jour))" 'formule matricielle nommée
    .FormatConditions.Add xlExpression, Formula1:="=ABS(A3-Jour)=Mini"
    .FormatConditions(1).Interior.Color = vbRed
    .FormatConditions(1).Font.Color = vbWhite
    .FormatConditions(1).Font.Bold = True 'gras
    With .Offset(, 1).SpecialCells(xlCellTypeFormulas)
        .FormatConditions.Add xlExpression, Formula1:=1
        .FormatConditions(1).Interior.Color = vbCyan
    End With
    .Resize(, 2) = a 'restitution
End With
Columns("A:B").AutoFit 'ajustement largeurs
Application.EnableEvents = True 'réactive les évènements
End Sub
 

Pièces jointes

Vote positif 0 Vote négatif
job75 à dit:
Je comprends que les heurs travaillées sont entrées manueellement.

La nouvelle macro qui crée 2 MFC :
VB: 
Private Sub Worksheet_Calculate()
Dim efface As Boolean, dat&, i&, a(1 To 118, 1 To 2) '118 = 2 x 53 semaines + 12
efface = Year(Date) <> Year(CStr([Jour])) 'test pour le début de l'année
Application.ScreenUpdating = False
[A3].Resize(UBound(a), 2).NumberFormat = "General" 'RAZ
For dat = DateSerial([A1], 1, 1) To DateSerial([A1], 12, 31)
    If Weekday(dat) = 3 Then
        i = i + 1
        a(i, 1) = dat
        If efface Then a(i, 2) = Empty Else a(i, 2) = Cells(i + 2, 2)
        Cells(i + 2, 1).NumberFormat = """Mardi"" * dd/mm/yyyy" 'format Date personnalisé
    ElseIf Weekday(dat) = 4 Then
        i = i + 1
        a(i, 1) = dat
        If efface Then a(i, 2) = Empty Else a(i, 2) = Cells(i + 2, 2)
        Cells(i + 2, 1).NumberFormat = """Mercredi"" * dd/mm/yyyy" 'format Date personnalisé
    End If
    If Month(dat) < Month(dat + 1) Then
        i = i + 1 'saut de ligne
        a(i, 2) = "=SUBTOTAL(9,B$3:B" & i + 1 & ")"
        Cells(i + 2, 2).NumberFormat = """Total ""0"
    End If
Next dat
a(i + 1, 2) = "=SUBTOTAL(9,B$3:B" & i + 2 & ")" 'dernier Total
Cells(i + 3, 2).NumberFormat = """Total ""0"
Application.EnableEvents = False 'désactive les évènements
With [A3].Resize(UBound(a))
    .Resize(, 2).FormatConditions.Delete 'RAZ
    ThisWorkbook.Names.Add "Jour", Date 'nom défini
    ThisWorkbook.Names.Add "Mini", "=MIN(ABS(" & .Address & "-Jour))" 'formule matricielle nommée
    .FormatConditions.Add xlExpression, Formula1:="=ABS(A3-Jour)=Mini"
    .FormatConditions(1).Interior.Color = vbRed
    .FormatConditions(1).Font.Color = vbWhite
    .FormatConditions(1).Font.Bold = True 'gras
    With .Offset(, 1).SpecialCells(xlCellTypeFormulas)
        .FormatConditions.Add xlExpression, Formula1:=1
        .FormatConditions(1).Interior.Color = vbCyan
    End With
    .Resize(, 2) = a 'restitution
End With
Columns("A:B").AutoFit 'ajustement largeurs
Application.EnableEvents = True 'réactive les évènements
End Sub
Cliquez pour agrandir...
Re,
Désolé d'abusé de votre temps, comme sur l'image jointe, c'est peut-être pas assez compréhensif, J'aimerai si possible "total" en colonne "A" entre 2 mois Et comme votre exemple, le total des heures en "B13" pour la plage d'heure du mois de janvier. ( 1 Total pour chaque mois prenant les 0.5 heure )
Et avec votre exemple, si je rajoute à la 1/2 heure, ça ne prend en compte cas l'arrondi supérieur (0.50).
Je pensais que l'image était compréhensive, désolé.
Merci.
🥺🥺

Comme je disais précedement: Le plus compliqué c'est de définir chaque plages de cellules et de les additionner entre 2 mois, et en le faisant proprement.
Malgré mon bricolage c'est un peu près le résultat que j'avais. 😉 😉
 

Pièces jointes

  • mon idée.jpg
    mon idée.jpg
    136.2 KB · Affichages: 12
Dernière édition:
Vote positif 0 Vote négatif
Nico_J à dit:
Re,
Désolé d'abusé de votre temps, comme sur l'image jointe, c'est peut-être pas assez compréhensif, J'aimerai si possible "total" en colonne "A" entre 2 mois Et comme votre exemple, le total des heures en "B13" pour la plage d'heure du mois de janvier. ( 1 Total pour chaque mois prenant les 0.5 heure )
Et avec votre exemple, si je rajoute à la 1/2 heure, ça ne prend en compte cas l'arrondi supérieur (0.50).
Je pensais que l'image était compréhensive, désolé.
Merci.
🥺🥺

Comme je disais précedement: Le plus compliqué c'est de définir chaque plages de cellules et de les additionner entre 2 mois, et en le faisant proprement.
Malgré mon bricolage c'est un peu près le résultat que j'avais. 😉 😉
Cliquez pour agrandir...
Je me reprends escusez-moi, en gros entre 2 mois, soit en colonne"A", juste le texte "Total" du mois concerné, et juste à coté, total des "Heures" en prenant en compte les 0.5 hrs.
Je sais pas comment expliquer mieux.
merci
 
Dernière édition:
Vote positif 0 Vote négatif
J'espère que cette fois-ci c'est bien ce que vous voulez :
VB: 
Private Sub Worksheet_Calculate()
Dim efface As Boolean, deb&, dat&, i&, a(1 To 118, 1 To 2) '118 = 2 x 53 semaines + 12
efface = Year(Date) <> Year(Val(CStr([Jour]))) 'test pour le début de l'année
Application.ScreenUpdating = False
[A3].Resize(UBound(a), 2).NumberFormat = "General" 'RAZ
deb = 3
For dat = DateSerial([A1], 1, 1) To DateSerial([A1], 12, 31)
    If Weekday(dat) = 3 Then
        i = i + 1
        a(i, 1) = dat
        If efface Then a(i, 2) = Empty Else a(i, 2) = Cells(i + 2, 2)
        Cells(i + 2, 1).NumberFormat = """Mardi"" * dd/mm/yyyy" 'format Date personnalisé
    ElseIf Weekday(dat) = 4 Then
        i = i + 1
        a(i, 1) = dat
        If efface Then a(i, 2) = Empty Else a(i, 2) = Cells(i + 2, 2)
        Cells(i + 2, 1).NumberFormat = """Mercredi"" * dd/mm/yyyy" 'format Date personnalisé
    End If
    If Month(dat) < Month(dat + 1) Then
        i = i + 1 'saut de ligne
        a(i, 1) = 0
        a(i, 2) = "=SUM(B" & deb & ":B" & i + 1 & ")"
        Cells(i + 2, 1).NumberFormat = """Total"""
        deb = i + 3
    End If
Next dat
'---dernier Total---
a(i + 1, 1) = 0
a(i + 1, 2) = "=SUM(B" & deb & ":B" & i + 2 & ")"
Cells(i + 3, 1).NumberFormat = """Total"""
'---restitution et MFC---
Application.EnableEvents = False 'désactive les évènements
With [A3].Resize(UBound(a))
    .Resize(, 2) = a 'restitution
    .Resize(, 2).FormatConditions.Delete 'RAZ
    ThisWorkbook.Names.Add "Jour", Date 'nom défini
    ThisWorkbook.Names.Add "Mini", "=MIN(ABS(" & .Address & "-Jour))" 'formule matricielle nommée
    .FormatConditions.Add xlExpression, Formula1:="=ABS(A3-Jour)=Mini"
    .FormatConditions(1).Interior.Color = vbRed
    .FormatConditions(1).Font.Color = vbWhite
    .FormatConditions(1).Font.Bold = True 'gras
    .Resize(, 2).FormatConditions.Add xlExpression, Formula1:="=""""&$A3=""0"""
    .Resize(, 2).FormatConditions(2).Interior.Color = vbCyan
    .Resize(, 2).FormatConditions(2).Font.Bold = True 'gras
End With
Columns("A:B").AutoFit 'ajustement largeurs
Application.EnableEvents = True 'réactive les évènements
End Sub
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
job75 à dit:
J'espère que cette fois ci c'est bien ce que vous voulez :
VB: 
Private Sub Worksheet_Calculate()
Dim efface As Boolean, deb&, dat&, i&, a(1 To 118, 1 To 2) '118 = 2 x 53 semaines + 12
efface = Year(Date) <> Year(CStr([Jour])) 'test pour le début de l'année
Application.ScreenUpdating = False
[A3].Resize(UBound(a), 2).NumberFormat = "General" 'RAZ
deb = 3
For dat = DateSerial([A1], 1, 1) To DateSerial([A1], 12, 31)
    If Weekday(dat) = 3 Then
        i = i + 1
        a(i, 1) = dat
        If efface Then a(i, 2) = Empty Else a(i, 2) = Cells(i + 2, 2)
        Cells(i + 2, 1).NumberFormat = """Mardi"" * dd/mm/yyyy" 'format Date personnalisé
    ElseIf Weekday(dat) = 4 Then
        i = i + 1
        a(i, 1) = dat
        If efface Then a(i, 2) = Empty Else a(i, 2) = Cells(i + 2, 2)
        Cells(i + 2, 1).NumberFormat = """Mercredi"" * dd/mm/yyyy" 'format Date personnalisé
    End If
    If Month(dat) < Month(dat + 1) Then
        i = i + 1 'saut de ligne
        a(i, 1) = 0
        a(i, 2) = "=SUM(B" & deb & ":B" & i + 1 & ")"
        Cells(i + 2, 1).NumberFormat = """Total"""
        deb = i + 3
    End If
Next dat
'---dernier Total---
a(i + 1, 1) = 0
a(i + 1, 2) = "=SUM(B" & deb & ":B" & i + 2 & ")"
Cells(i + 3, 1).NumberFormat = """Total"""
'---restitution et MFC---
Application.EnableEvents = False 'désactive les évènements
With [A3].Resize(UBound(a))
    .Resize(, 2) = a 'restitution
    .Resize(, 2).FormatConditions.Delete 'RAZ
    ThisWorkbook.Names.Add "Jour", Date 'nom défini
    ThisWorkbook.Names.Add "Mini", "=MIN(ABS(" & .Address & "-Jour))" 'formule matricielle nommée
    .FormatConditions.Add xlExpression, Formula1:="=ABS(A3-Jour)=Mini"
    .FormatConditions(1).Interior.Color = vbRed
    .FormatConditions(1).Font.Color = vbWhite
    .FormatConditions(1).Font.Bold = True 'gras
    .Resize(, 2).FormatConditions.Add xlExpression, Formula1:="=""""&$A3=""0"""
    .Resize(, 2).FormatConditions(2).Interior.Color = vbCyan
    .Resize(, 2).FormatConditions(2).Font.Bold = True 'gras
End With
Columns("A:B").AutoFit 'ajustement largeurs
Application.EnableEvents = True 'réactive les évènements
End Sub
Cliquez pour agrandir...
Euh si je peux me permettre, c'est parfait.
Merci vraiment beaucoup, je vais l'étudier pour comprendre mais le résultat est ce que je voulais,mais c'est pas évident de se faire comprendre par message, comme les sms, je déteste. merci beaucoup, vraiment.
 
Vote positif 0 Vote négatif
job75 à dit:
C'est vrai que c'est compliqué : je viens d'ajouter Val sur la 3ème ligne de la macro...

Pourquoi commencez-vous les dates en A3 et pas en A2 ?
Cliquez pour agrandir...
C'est pas pour vous embêter promis, c'est juste si je veux ajouter des annotations au cas ou et je vais figer dans le haut, pour avoir de la place et pas vous embêter à nouveau.
et le Val j'ai pas compris ou et pour quoi ?
Merci encore
Nicolas
 
Vote positif 0 Vote négatif
Je parlais du Val mis sur la ligne qui calcule la variable efface (3ème ligne).

Voici une nouvelle macro, il suffit de modifier sa 8ème ligne pour changer la ligne de début :
VB: 
Private Sub Worksheet_Calculate()
Dim efface As Boolean, deb&, dat&, i&, a(1 To 118, 1 To 2) '118 = 2 x 53 semaines + 12
efface = Val(CStr([A1])) <> Val(CStr([Annee])) 'test pour le début de l'année
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
ThisWorkbook.Names.Add "Annee", Val([A1])
deb = 1
With [A3].Resize(UBound(a)) '1ère ligne à adapter au besoin
    .Resize(, 1 - efface).ClearContents 'RAZ
    For dat = DateSerial([Annee], 1, 1) To DateSerial([Annee], 12, 31)
        If Weekday(dat) = 3 Then
            i = i + 1
            a(i, 1) = dat
            If Not efface Then a(i, 2) = .Cells(i, 2)
            .Cells(i).NumberFormat = """Mardi"" * dd/mm/yyyy" 'format Date personnalisé
        ElseIf Weekday(dat) = 4 Then
            i = i + 1
            a(i, 1) = dat
            If Not efface Then a(i, 2) = .Cells(i, 2)
            .Cells(i).NumberFormat = """Mercredi"" * dd/mm/yyyy" 'format Date personnalisé
        End If
        If Month(dat) < Month(dat + 1) Then
            i = i + 1 'saut de ligne
            a(i, 1) = 0
            a(i, 2) = "=SUM(" & .Cells(deb, 2).Resize(i - deb).Address(0, 0) & ")"
            .Cells(i).NumberFormat = """Total"""
            deb = i + 1
        End If
    Next dat
    '---dernier Total---
    a(i + 1, 1) = 0
    a(i + 1, 2) = "=SUM(" & .Cells(deb, 2).Resize(i + 1 - deb).Address(0, 0) & ")"
    .Cells(i + 1, 1).NumberFormat = """Total"""
    '---restitution et MFC---
    .Resize(, 2) = a 'restitution
    .Resize(, 2).FormatConditions.Delete 'RAZ
    ThisWorkbook.Names.Add "Jour", Date 'nom défini
    ThisWorkbook.Names.Add "Mini", "=MIN(ABS(" & .Address & "-Jour))" 'formule matricielle nommée
    .FormatConditions.Add xlExpression, Formula1:="=ABS(A3-Jour)=Mini"
    .FormatConditions(1).Interior.Color = vbRed
    .FormatConditions(1).Font.Color = vbWhite
    .FormatConditions(1).Font.Bold = True 'gras
    .Resize(, 2).FormatConditions.Add xlExpression, Formula1:="=""""&$A3=""0"""
    .Resize(, 2).FormatConditions(2).Interior.Color = vbCyan
    .Resize(, 2).FormatConditions(2).Font.Bold = True 'gras
End With
Columns("A:B").AutoFit 'ajustement largeurs
Application.EnableEvents = True 'réactive les évènements
End Sub
 

Pièces jointes

Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

libellule85
  • Question Question
Microsoft 365 Connaitre le nombre de mardi, mercredi etc.. dans une colonne dynamique
Réponses
7
Affichages
269
Gégé-45550
Gégé-45550
P
  • Résolu(e)
Microsoft 365 Utiliser la même macro dans des feuilles différentes
2 3
Réponses
35
Affichages
362
cathodique
cathodique
Electron24
  • Résolu(e)
Microsoft 365 Info manquante
Réponses
2
Affichages
53
Electron24
Electron24
C
  • Question Question
XL pour MAC Répartir des personnes dans des équipes par roulement sur 5 jours
Réponses
6
Affichages
757
job75
job75
A
  • Question Question
Microsoft 365 Dénombrer tous les couples selon 2 listes
Réponses
7
Affichages
57
alexitt
A
D
  • Résolu(e)
Microsoft 365 VBA - Lister les photos sélectées dans l'Explorateur Windows
2 3 4
Réponses
50
Affichages
1 K
danielco
D
C
  • Résolu(e)
XL 2016 Analyse de Code VBA : Variables inutilisées
2
Réponses
19
Affichages
346
crocrocro
C
Electron24
  • Question Question
Microsoft 365 Graphique par date
Réponses
4
Affichages
289
Electron24
Electron24
G
  • Question Question
Microsoft 365 Date en fonction de plusieurs critères
Réponses
2
Affichages
86
Gerantoine
G
DoubleZero
  • Question Question
XL 2021 Mots et maux : colorer et lister
2
Réponses
29
Affichages
968
DoubleZero
DoubleZero
D
  • Question Question
XL 2021 création de planning perpétuel annualisé
Réponses
1
Affichages
453
vgendron
vgendron
R
  • Résolu(e)
Microsoft 365 Planning 5x8
Réponses
4
Affichages
333
fanfan38
fanfan38
LB04
  • Question Question
XL 2019 compter les vendredi entre deux dates
Réponses
11
Affichages
685
LB04
LB04
D
  • Résolu(e)
Microsoft 365 planning repos tournant
Réponses
5
Affichages
572
piga25
piga25
C
Bonjour je m'appelle christelle. Je vis en ecovillage dans le sud en Ariege
Réponses
1
Affichages
353
Aya_flo
A
N
  • Question Question
Microsoft 365 Choisir une imprimante pour imprimer doc word sous VBA Excel
Réponses
2
Affichages
77
natof
N
N
  • Question Question
Microsoft 365 Aide sur un classeur Excel
Réponses
5
Affichages
96
nike780
N
eddy1975
  • Résolu(e)
XL 2019 Heures réelles du mois
Réponses
3
Affichages
466
eddy1975
eddy1975
C
  • Question Question
Microsoft 365 Liste déroulante dynamique / dépendante d'un critère ou plus, *sans* VBA ? Une sorte d'Unique à conditions ? + ordre alpha ?
Réponses
8
Affichages
199
JHA
J
B
  • Résolu(e)
Microsoft 365 Recherche formule
Réponses
7
Affichages
735
TooFatBoy
TooFatBoy
Retour