Autres Macro pour remplir automatiquement une sélection avec une date

[dysorthographie]

Bonjour,

J’ai écrit une macro pour remplir toutes les cellules d’une sélection avec une date calculée automatiquement :

Sub CalculDate()
    Dim c As Range
    Dim y As Long, m As Long, d As Long
   
    For Each c In Selection
        y = Year(Date)
       
        m = ((c.Row * 3 + c.Column * 5) Mod 12) + 1
        d = ((c.Row * 7 + c.Column * 11) Mod 31) + 1
       
        m = m - ((m - 4) Mod 12)
        d = d - ((d - 1) Mod 31)
       
        c.Value = Format(DateSerial(y, m, d), "d  mmmm yyyy")
    Next c
End Sub

Le but est de générer automatiquement une date basée sur la position des cellules dans la sélection.

Problème rencontré :

• La macro fonctionne sur toutes les cellules, mais je ne suis pas sûr que le calcul pour m et d soit correct ou optimisé.
• Je voudrais que la macro soit robuste et fonctionne pour toutes les cellules, même si elles contiennent du texte ou sont vides.

Question :
Comment améliorer cette macro pour qu’elle soit plus claire et fiable, tout en conservant l’idée de calcul basé sur la position des cellules ?

Merci d’avance pour vos conseils.

 

[bsalv]

je ne comprends pas bien le but et si je lance cette macro, c'est douteux ...
une proposition

Sub Calculdate2()
     Dim cl, N, i, aSeq
     With Selection
          N = .Cells.Count                   'nombre de cellules
          aSeq = Evaluate(Replace("row(offset(a1,today()-#/2,,#))", "#", N))     'toutes vos dates
          'aSeq = WorksheetFunction.Sequence(N, , Int(Date - (N / 2)))     'oubien à partir d'excel 2019
          For Each cl In .Cells
               i = i + 1
               cl.Value2 = aSeq(i, 1)
          Next
          .Numberformat="d  mmmm yyyy"   'oubien "j mmmm aaaa"  en france ???
     End With
End Sub

 

[dysorthographie]

Bonjour,

Sub CalculDate()
    Dim c As Range
    Dim y As Long, m As Long, d As Long
 
    For Each c In Selection
        y = Year(Date)
 
        m = ((c.Row * 3 + c.Column * 5) Mod 12) + 1
        d = ((c.Row * 7 + c.Column * 11) Mod 31) + 1
 
        m = m - ((m - 4) Mod 12)
        d = d - ((d - 1) Mod 31)
 
        c.Value = Format(DateSerial(y, m, d), "d  mmmm yyyy")
    Next c
End Sub

je ne comprends pas bien le but et si je lance cette macro, c'est douteux ...
...

🤣😂