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

dysorthographie · Hier à 12:29

Bonjour,

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

VB:

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.

dysorthographie · Aujourd'hui à 01:21

Bonjour,

VB:

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

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

🤣😂

bsalv · Hier à 14:01

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

VB:

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 · Aujourd'hui à 01:21

Bonjour,

VB:

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

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

🤣😂

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

dysorthographie

XLDnaute Barbatruc

dysorthographie

bsalv

XLDnaute Occasionnel

dysorthographie

XLDnaute Barbatruc

Discussions similaires

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

dysorthographie

XLDnaute Barbatruc

bsalv

XLDnaute Occasionnel

dysorthographie

XLDnaute Barbatruc

Discussions similaires

Privacy & Transparency

Privacy & Transparency