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

[Nicolas JACQUIN]

Bonjour à tous,

Comment lister les mardi et les mercredi d'une année en VBA

Merci d'avance

 

[Nicolas JACQUIN]

Re,

Ma première version modifiée pour passer de noir & blanc en couleur.
Suivant les types de jours retenus, il se peut qu'une cellule ou deux soient colorées.

Je comprends pas tout, mais ça fonctionne bien. Merci

 

[Nicolas JACQUIN]

Re,

Ma première version modifiée pour passer de noir & blanc en couleur.
Suivant les types de jours retenus, il se peut qu'une cellule ou deux soient colorées.

J'avais dit que c'était ma dernière requête mais si dans une semaine j'ouvre mon classeur la couleur sur la date ne va pas se réactualiser ?

 

[job75]

mais si dans une semaine j'ouvre mon classeur la couleur sur la date ne va pas se réactualiser ?

En A1 mettez la formule volatile =ANNEE(AUJOURDHUI())
et utilisez la macro :

Private Sub Worksheet_Calculate()
Dim i&, mini&, ecart&, lig&
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
Range("A2:A" & Rows.Count).Clear 'RAZ
[A2] = DateSerial([A1], 1, 1) '1er janvier
With [A2:A367]
    .NumberFormat = "ddd dd/mm/yyyy"
    .DataSeries
    If Day(.Cells(.Count)) = 1 Then .Cells(.Count).Delete xlUp
    For i = .Count To 1 Step -1
        If Weekday(.Cells(i)) < 3 Or Weekday(.Cells(i)) > 4 Then .Cells(i).Delete xlUp
    Next i
    For i = .Count To 2 Step -1
        If Month(.Cells(i)) > Month(.Cells(i - 1)) Then .Cells(i).Insert xlDown
    Next i
    mini = 9 ^ 9
    For i = 1 To .Count
        ecart = Abs(.Cells(i) - Date)
        If ecart < mini Then mini = ecart: lig = i
    Next i
    .Cells(lig).Interior.Color = vbCyan
End With
Application.EnableEvents = True 'réactive les évènements
End Sub

 

[mapomme]

Re,

Ma version v3 pour que la coloration de la police du jour ou des deux jours les plus proches de la date courante n'oblige pas à relancer la macro (on passe par une MFC mise en place par la macro).

 

[Nicolas JACQUIN]

Merci vraiment à tous,
plus cas apprendre tout ça, les fonctionnements ..
Merci

 

[patricktoulon]

bonjour Nicolas
2d essai

Option Explicit

Sub JoursParticuliers()
    Dim tbl(), J&, A&, D As Date, lig&, mois, Q&, Q2&
    Dim Debut As Date, Fin As Date, i&, leMois&, n&
    ' lun->1; mar->2; mer->3; jeu->4; ven->5; sam->6; dim->7' séparés par un espace
    Const Jours = " 2 3 "
    Const Ici = "b4"        ' première cellule pour l'affichage du résultat
    Q2 = 365: mois = 1
    
    With Sheets("Feuil1")
        Debut = Int(.[b1]): Fin = Int(.[b2])
      
        For J = 0 To 365
            D = CDate(Debut) + J
            If Jours Like "* " & Weekday(D, 2) & " *" Then
                If Month(D) <> mois Then A = A + 1: ReDim Preserve tbl(1 To A): mois = Month(D)
                A = A + 1: ReDim Preserve tbl(1 To A): tbl(A) = CLng(D)
                Q = Abs(DateDiff("d", Date, D, vbMonday, vbUseSystem))
                If Q < Q2 Then Q2 = Q: lig = A
            End If
        Next


        With .Range(Ici).Resize(UBound(tbl))
            .ClearContents
            .Interior.Color = xlNone
            .Value = Application.Transpose(tbl)
            .NumberFormat = "dddd dd mmmm yyyy"
            .Cells(lig).Interior.Color = RGB(255, 180, 0)

        End With
    End With
End Sub

 

[Nicolas JACQUIN]

Re, plus on m'en rajoute, plus j'en veux

J'aime bien le code de @job75 par rapport à l'année qui est juste à mettre en haut.
Et j'aime beaucoup aussi le code de @mapomme avec la MFC, connaissais pas.

Et j'ai essayé un peu dans tout les sens mais sans succès:
".Proper (Format(Ladate, "dddd dd/mm/yyyy"))"

Donc si je peu avoir un mix des deux se serait super.

A trop en recevoir on en demande toujours plus, il sont chiant les clients

Merci Patrick pour ton code j'ai pas trop regardé encore.

Merci encore à tous et toutes

 

[Laurent78]

Bonjour à tous,

Comment lister les mardi et les mercredi d'une année en VBA

Merci d'avance

Bonjour,

Petite question : pourquoi en VBA ?

 

[Nicolas JACQUIN]

Bonjour,
je préfère et je trouve qu'il y a plus de choix de manoeuvre.
Merci

 

[Cousinhub]

Bonjour,
Pour le fun, un essai avec Power Query
Choisir l'année, les jours voulus, et ruban "Données", "Actualiser tout"
Bon W-E

 

[Laurent78]

pour le fun, juste parce que je me demandais si cela était possible sans vba ;-)

 

[job75]

Bonjour à tous,

Et j'ai essayé un peu dans tout les sens mais sans succès:
".Proper (Format(Ladate, "dddd dd/mm/yyyy"))"

Pour obtenir des majuscules il faut des formats Date personnalisés pour le Mardi et le Mercredi :

Private Sub Worksheet_Calculate()
Dim i&, mini&, ecart&, lig&
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
Range("A2:A" & Rows.Count).Clear 'RAZ
[A2] = DateSerial([A1], 1, 1) '1er janvier
With [A2:A367]
    .DataSeries
    If Day(.Cells(.Count)) = 1 Then .Cells(.Count).Delete xlUp
    For i = .Count To 1 Step -1
        If Weekday(.Cells(i)) < 3 Or Weekday(.Cells(i)) > 4 Then .Cells(i).Delete xlUp
    Next i
    For i = .Count To 2 Step -1
        If Month(.Cells(i)) > Month(.Cells(i - 1)) Then .Cells(i).Insert xlDown
    Next i
    mini = 9 ^ 9
    For i = 1 To .Count
        ecart = Abs(.Cells(i) - Date)
        If ecart < mini Then mini = ecart: lig = i
        If Weekday(.Cells(i)) = 3 Then .Cells(i).NumberFormat = """Mardi"" * dd/mm/yyyy" 'format Date personnalisé
        If Weekday(.Cells(i)) = 4 Then .Cells(i).NumberFormat = """Mercredi"" * dd/mm/yyyy" 'format Date personnalisé
    Next i
    .Cells(lig).Interior.Color = vbCyan
End With
Application.EnableEvents = True 'réactive les évènements
End Sub

Edit : ajouté un astérisque pour séparer et cadrer le texte.

A+

 

[job75]

Bonjour Nico_J, le forum,

Une solution plus élaborée et plus rapide avec la couleur appliquée par MFC :

Private Sub Worksheet_Calculate()
Dim dat&, i&, a(1 To 117) '117 = 2 x 53 semaines + 11
Application.ScreenUpdating = False
For dat = DateSerial([A1], 1, 1) To DateSerial([A1], 12, 31)
    If Weekday(dat) = 3 Then
        i = i + 1
        a(i) = dat
        Cells(i + 1, 1).NumberFormat = """Mardi"" * dd/mm/yyyy" 'format Date personnalisé
    ElseIf Weekday(dat) = 4 Then
        i = i + 1
        a(i) = dat
        Cells(i + 1, 1).NumberFormat = """Mercredi"" * dd/mm/yyyy" 'format Date personnalisé
    End If
    If Month(dat) < Month(dat + 1) Then i = i + 1 'saut de ligne
Next dat
Application.EnableEvents = False 'désactive les évènements
With [A2].Resize(UBound(a))
    .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(A2-Jour)=Mini"
    .FormatConditions(1).Interior.Color = vbCyan
    .Value = Application.Transpose(a) 'restitution
End With
Columns(1).AutoFit 'ajustement largeur
Application.EnableEvents = True 'réactive les évènements
End Sub

Comme chez mapomme aujourd'hui 13/04 les 10/04 et 16/04 sont colorés.

Notez que la MFC fonctionne quelle que soit la langue de l'ordinateur.

A+

 

[Nicolas JACQUIN]

Bonjour job75,

J'étais juste entrain de comprendre le fonctionnement de votre code précédent, enfin presque
Je me tire les cheveux (plus beaucoup déjà ) depuis hier soir pour essayer de faire quel quelchose de cohérant sur un calcul d'heure mais j'ai du mal, voir fichier joint.
Eventuellement décaler sur gauche ce que j'ai rajouter.
Je bricole mais je pense pas que c'est ce qu'il faut faire.
Peut-être plus créer une autre sub en complément de la votre.

 

[job75]

Oui c'est du bricolage et malheureusement il n'a pas grand sens.

Exprimez clairement votre besoin.