XL 2019 Remplissage automatique des cellules excel à partir d'une Macro

[ajox01]

Bonjour
J'ai besoin de votre aide: Je voudrais remplir la colonne B du fichier joint de manière automatique à partir d'une Macro. Je voudrais que le chiffre "1" s'affiche en face de chaque mois à chaque fois que j'exécute la Macro....

Merci de votre aide
Cordialement
ajox01

 

[Staple1600]

Re

=>ajox01
Alors, puisque tu aimes le VBA, te voilà servi
(prévois du paracétamol, parce que là, ce de l'initiation "hardcore" )

Sub mT1()
mTrimestre 1
End Sub
Sub mT2()
mTrimestre 2
End Sub
Sub mS1()
mSemestre 1
End Sub
Sub mS2()
mSemestre 2
End Sub
Sub mAn2020()
mAnnée
End Sub
Sub mAn2019()
mAnnée 2019
End Sub
Private Sub mTrimestre(Optional NumTrim As Long = 1)
With [B2].Resize(Cells(Rows.Count, 1).End(3).Row - 1)
.ClearContents
.FormulaR1C1 = "=REPT(1,CEILING(MONTH(RC1)/3,1)=" & NumTrim & ")"
.Value = .Value
End With
End Sub
Private Sub mSemestre(Optional NumS As Long = 1)
With [B2].Resize(Cells(Rows.Count, 1).End(3).Row - 1)
.ClearContents
.FormulaR1C1 = "=IF(YEAR(RC1)=YEAR(TODAY()),REPT(1,ROUNDUP(MONTH(RC1)/6,0)=" & NumS & "),"""")"
.Value = .Value
End With
End Sub
Private Sub mAnnée(Optional mYear = 2020)
With [B2].Resize(Cells(Rows.Count, 1).End(3).Row - 1)
.ClearContents
.FormulaR1C1 = "=REPT(1,YEAR(RC1)=" & mYear & ")"
.Value = .Value
End With
End Sub

Si tu as des questions, n'hésites pas
(ma lessive tourne toujours, j'ai du temps )

 

[ajox01]

Re

=>ajox01
Alors, puisque tu aimes le VBA, te voilà servi
(prévois du paracétamol, parce que là, ce de l'initiation "hardcore" )

Sub mT1()
mTrimestre 1
End Sub
Sub mT2()
mTrimestre 2
End Sub
Sub mS1()
mSemestre 1
End Sub
Sub mS2()
mSemestre 2
End Sub
Sub mAn2020()
mAnnée
End Sub
Sub mAn2019()
mAnnée 2019
End Sub
Private Sub mTrimestre(Optional NumTrim As Long = 1)
With [B2].Resize(Cells(Rows.Count, 1).End(3).Row - 1)
.ClearContents
.FormulaR1C1 = "=REPT(1,CEILING(MONTH(RC1)/3,1)=" & NumTrim & ")"
.Value = .Value
End With
End Sub
Private Sub mSemestre(Optional NumS As Long = 1)
With [B2].Resize(Cells(Rows.Count, 1).End(3).Row - 1)
.ClearContents
.FormulaR1C1 = "=IF(YEAR(RC1)=YEAR(TODAY()),REPT(1,ROUNDUP(MONTH(RC1)/6,0)=" & NumS & "),"""")"
.Value = .Value
End With
End Sub
Private Sub mAnnée(Optional mYear = 2020)
With [B2].Resize(Cells(Rows.Count, 1).End(3).Row - 1)
.ClearContents
.FormulaR1C1 = "=REPT(1,YEAR(RC1)=" & mYear & ")"
.Value = .Value
End With
End Sub

Si tu as des questions, n'hésites pas
(ma lessive tourne toujours, j'ai du temps )

Merci bcp Maître
je vais bosser la démarche! j'espère que je ne serai pas abîmé...
Cordialement

 

[Staple1600]

Re

Normalement, mon dernier code fait ce que tu souhaites.
Si tu as des questions, prends le temps de les préparer
Car maintenant ma lessive est over
Et m'en vais l'étendre
Et après petit frichti
Donc je serai loin de mon clavier pendant un certain temps

 

[ajox01]

Re

Normalement, mon dernier code fait ce que tu souhaites.
Si tu as des questions, prends le temps de les préparer
Car maintenant ma lessive est over
Et m'en vais l'étendre
Et après petit frichti
Donc je serai loin de mon clavier pendant un certain temps

Ok got it
A bientôt
Merci encore et encore