Bonjour à tous,
Comment lister les mardi et les mercredi d'une année en VBA
Merci d'avance
Comment lister les mardi et les mercredi d'une année en VBA
Merci d'avance
XL 2021 Comment lister mardi et mercredi d'une année VBA
- Initiateur de la discussion Nicos
- Date de début
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
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
Dernière édition:
job75
XLDnaute Barbatruc
Je comprends que les heurs travaillées sont entrées manueellement.
La nouvelle macro qui crée 2 MFC :
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 SubRe,
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
Dernière édition:
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.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.
Je sais pas comment expliquer mieux.
merci
Dernière édition:
job75
XLDnaute Barbatruc
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
Dernière édition:
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.
Je pensais que cela aurait été plus simple, vraiment désolé et un grand MERCI
job75
XLDnaute Barbatruc
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 ?
Pourquoi commencez-vous les dates en A3 et pas en A2 ?
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
job75
XLDnaute Barbatruc
Sans Val la macro beugue quand on supprime le nom défini Jour.
On le place ou ??
JE NE PEUX MËME PAS FAIRE DE CAPTURE, ERREUR 1004
job75
XLDnaute Barbatruc
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 :
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 SubRe, dans la forme ça fonctionne, la seul chose apparemment c'est que ça ne prends pas en compte les 0.5hrs, ça arrondi au supérieur.
Discussions similaires
- Question
- Question
