Modification de Sub "date"

envol · 17 Février 2011

Bonsoir à tous,

La petite sub me permet de répéter les dates sur une même colonne comme ceci:
01/01/2011
01/01/2011
02/01/2011
02/01/2011

Sub Remplissage()
Dim Cellule As Range, MaDate As Date, Premier As Boolean
Premier = True
MaDate = InputBox("Date de départ :")
For Each Cellule In Selection
Cellule = MaDate
If Premier = True Then
Premier = False
Else
MaDate = MaDate + 1
Premier = True
End If
Next
End Sub

Que faut-il modifier pour jouer sur le nbr de répétions, svp ?😕
Par ex: que modifier pour avoir 5 fois chaque dates ?

ROGER2327 · 17 Février 2011

Re : Modification de Sub "date"

Bonsoir envol

Essayez ceci :

VB:

Sub Remplissage() Dim Cellule As Range, MaDate As Date, Premier As Long, P As Long MaDate = CDate(InputBox("Date de départ :")) - 1 Premier = InputBox("Nombre de répétiton :") For Each Cellule In Selection If (P Mod Premier) = 0 Then MaDate = MaDate + 1 Cellule = MaDate P = P + 1 Next End Sub

ROGER2327
#4955

Lundi 23 Gueules 138 (Occultation de Saint J Torma, euphoriste, SQ)
29 Pluviôse An CCXIX
2011-W07-4T22:03:20Z

envol · 18 Février 2011

Re : Modification de Sub "date"

Bonsoir Roger,

Merci beaucoup. ça marche très bien.
Après cette 1ère Sub, j'en lance 3 autres pour
- fusionner les mêmes dates (cela me permet d'avoir une seule date pour 8 lignes)
- colorier les samedis et dimanches + jours fériés.

Dans le cas de la fusion, j'obtiens une fusion partielle et il reste 4 dates sur 8 identiques.
Comment la modifier pour avoir une seule date pour 8 lignes, svp ?

Sub Fusion()
Dim Cellule As Range, Premier As Boolean
Premier = True
Application.DisplayAlerts = False
For Each Cellule In Selection
If Premier = True Then
Range(Cellule, Cellule.Offset(1, 0)).Merge
Premier = False
Else
Premier = True
End If
Next
Application.DisplayAlerts = True
End Sub

Bonne nuit

Modification de Sub "date"

envol

XLDnaute Occasionnel

ROGER2327

XLDnaute Barbatruc

envol

XLDnaute Occasionnel

Discussions similaires

Modification de Sub "date"

envol

XLDnaute Occasionnel

ROGER2327

XLDnaute Barbatruc

envol

XLDnaute Occasionnel

Discussions similaires

Privacy & Transparency

Privacy & Transparency