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

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

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

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

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