VBA : boucle pour incrémenter les 7 jours de la semaine

cibleo

cibleo

XLDnaute Impliqué
Bonsoir le forum,

Dans le module1, j'ai repris un code de job75 qui me permait de dupliquer 53 feuilles (semaines de 2011) en nommant chaque onglet et en y insérant un titre en B1.

Dans la plage (A4:A10) de chaque feuille dupliquée, j'aimerais y ajouter les 7 dates correspondantes du Lundi au dimanche.
Code: 
Sub FeuillesSemaines1()
Dim deb As Long, fin As Long, i As Long, n As Byte, tablo(1 To 53, 1 To 2), sem As Byte, nom As String, nom1 As String
deb = DateSerial(2010, 12, 27) 'du Lundi 27 décembre 2010
fin = DateSerial(2012, 1, 1)   'au Dimanche 01 janvier 2012 soit 53 semaines
For i = deb To fin
  If i = deb Or Weekday(i) = 2 Then n = n + 1: tablo(n, 1) = Format(i, "dd mmm yy")
  If i = Date Then sem = n
  If i = fin Or Weekday(i) = 1 Then tablo(n, 2) = Format(i, "dd mmm yy")
Next
Application.ScreenUpdating = False
On Error Resume Next
For i = 1 To n
  nom = "Semaine " & tablo(i, 1) & " - " & tablo(i, 2)
  nom1 = "Semaine du " & Format(tablo(i, 1), "dddd dd mmmm yyyy") & " au " & Format(tablo(i, 2), "dddd dd mmmm yyyy")
  nom = Sheets(nom).Name
  If Err Then
    Err = 0
    Sheets("Modele").Copy after:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = nom
    Sheets(Sheets.Count).[B1] = nom1
  End If
Next
Sheets("Semaine " & tablo(sem, 1) & " - " & tablo(sem, 2)).Select 'semaine en cours
End Sub
Dans le bloc If Err Then, j'ai voulu rajouter ceci :

Code: 
.../...
With ActiveSheet
   For Lig = 4 To 10
    .Cells(Lig, 1) = tablo(i, 1)
   Next Lig
'End With
.../...

Mais bon, l'incrémentation des jours ne s'effectuent pas :(
Décidemment, j'ai une aversion pour les variables tableau.

Merci de votre aide Cibleo
 

Pièces jointes

  • Semaines2011bis.xls
    20 KB · Affichages: 105
  • Semaines2011bis.xls
    20 KB · Affichages: 111
  • Semaines2011bis.xls
    20 KB · Affichages: 111
Dernière édition:
Trier par date Trier par votes
JCGL

JCGL

XLDnaute Barbatruc
Re : VBA : boucle pour incrémenter les 7 jours de la semaine

Bonjour à tous,

Dans ta feuille "Modèle" tu rajoutes en A5 : =A4+1 et tu tires jusqu'en A10

Tu rajoutes cette ligne dans le code :

Sheets(Sheets.Count).[A4] = Tablo(i, 1)
Cliquez pour agrandir...


If Err Then
Err = 0
Sheets("Modele").Copy after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = Nom
Sheets(Sheets.Count).[A4] = Tablo(i, 1)
Sheets(Sheets.Count).[B1] = Nom1
End If
Cliquez pour agrandir...

A+ à tous
 
Vote positif 0 Vote négatif
cibleo

cibleo

XLDnaute Impliqué
Bonsoir JCGL et merci pour ta réponse.

Dans la feuille "Modele", A4:A10 est formaté comme ceci : jjj jj mmm aa
Le format renvoyé doit donc correspondre à ceci : Lun 27 déc 10
Or j'obtiens visuellement ce format : 27 déc 10 dans toutes les cellules A4 des feuilles dupliquées.

Par contre A5:A10 renvoie le bon format.
Les cellules A4:A10 des feuilles dupliquées ont pourtant le format jjj jj mmm aa
Comprend pas :(

Y a pas un autre moyen que de passer par une formule dans la feuille "Modele"

Cibleo
 
Vote positif 0 Vote négatif
JCGL

JCGL

XLDnaute Barbatruc
Re : VBA : boucle pour incrémenter les 7 jours de la semaine

Bonjour à tous,

Peux-tu essayer avec le code de Job, :):), très légèrement modifié:

VB: 
Sub FeuillesSemaines()
    Dim Deb As Long, Fin As Long, i As Long, n As Byte, Tablo(1 To 53, 1 To 2), Sem As Byte, Nom As String, Nom1 As String

    Deb = DateSerial(2010, 12, 27)    'du Lundi 27 décembre 2010
    Fin = DateSerial(2012, 1, 1)   'au Dimanche 25 décembre 2011 soit 52 semaines
    For i = Deb To Fin
        If i = Deb Or Weekday(i) = 2 Then n = n + 1: Tablo(n, 1) = Format(i, "dd mmm yy")
        If i = Date Then Sem = n
        If i = Fin Or Weekday(i) = 1 Then Tablo(n, 2) = Format(i, "dd mmm yy")
    Next

    Application.ScreenUpdating = False
    On Error Resume Next
    For i = 1 To n
        Nom = "Semaine " & Tablo(i, 1) & " - " & Tablo(i, 2)
        Nom1 = "Semaine du " & Format(Tablo(i, 1), "dddd dd mmmm yyyy") & " au " & Format(Tablo(i, 2), "dddd dd mmmm yyyy")
        Nom = Sheets(Nom).Name
        If Err Then
            Err = 0
            Sheets("Modele").Copy after:=Sheets(Sheets.Count)
            Sheets(Sheets.Count).Name = Nom
            Sheets(Sheets.Count).[A4] = Format(Deb, "ddd dd mmm yy")
            Sheets(Sheets.Count).[A5] = Format(Deb + 1, "ddd dd mmm yy")
            Sheets(Sheets.Count).[A6] = Format(Deb + 2, "ddd dd mmm yy")
            Sheets(Sheets.Count).[A7] = Format(Deb + 3, "ddd dd mmm yy")
            Sheets(Sheets.Count).[A8] = Format(Deb + 4, "ddd dd mmm yy")
            Sheets(Sheets.Count).[A9] = Format(Deb + 5, "ddd dd mmm yy")
            Sheets(Sheets.Count).[A10] = Format(Deb + 6, "ddd dd mmm yy")
            Sheets(Sheets.Count).[B1] = Nom1
        End If
        Deb = Deb + 7
    Next
    Sheets("Semaine " & Tablo(Sem, 1) & " - " & Tablo(Sem, 2)).Select    'semaine en cours
End Sub

A+ à tous
 
Vote positif 0 Vote négatif
cibleo

cibleo

XLDnaute Impliqué
Re: Re : VBA : boucle pour incrémenter les 7 jours de la semaine

Bonjour à tous,
Bonjour JCGL,

Je reviens et j'avance doucement :
Au code initial, j'ai rajouté une variable tableau à 2 dimensions qui stocke les 371 dates (53 semaines de 7 jours)
Dim tablo1(1 To 53, 1 To 7)
Cliquez pour agrandir...
et rajouter la boucle For y ci-dessous.

Code: 
Sub FeuillesSemaines1()
Dim deb As Long, fin As Long, i As Long, n As Byte, tablo(1 To 53, 1 To 2), sem As Byte, nom As String, nom1 As String
Dim tablo1(1 To 53, 1 To 7), x As Integer, y As Byte, k As Byte, j As Byte
deb = DateSerial(2010, 12, 27) 'du Lundi 27 décembre 2010
fin = DateSerial(2012, 1, 1)   'au Dimanche 01 janvier 2012 soit 53 semaines
For y = 1 To 53
  For k = 1 To 7
    tablo1(y, k) = Format(deb + x, "ddd dd mmm yy")
    x = x + 1
  Next k
Next y
For i = deb To fin
  If i = deb Or Weekday(i) = 2 Then n = n + 1: tablo(n, 1) = Format(i, "dd mmm yy")
  If i = Date Then sem = n
  If i = fin Or Weekday(i) = 1 Then tablo(n, 2) = Format(i, "dd mmm yy")
Next
.../...

Puis cette instruction dans la condition If Err Then ...

Code: 
Sheets(Sheets.Count).[A4:A10] = WorksheetFunction.Transpose(tablo1(i, 1))

Exécuter la macro et voyez le résultat, c'est presque que ça.
Un dernier coup de pouce
Merci Cibleo

Edit : pas vu ta réponse JCGL, je vois ça.
 

Pièces jointes

  • Semaines2011bis.xls
    20.5 KB · Affichages: 110
  • Semaines2011bis.xls
    20.5 KB · Affichages: 122
  • Semaines2011bis.xls
    20.5 KB · Affichages: 123
Vote positif 0 Vote négatif
cibleo

cibleo

XLDnaute Impliqué
Re: Re : VBA : boucle pour incrémenter les 7 jours de la semaine

Génial JCGL :):)

Le résultat est obtenu, je décrypte à coups de F8.

Par contre, si quelqu'un pouvait intervenir pour compléter mon code du post #5#, cela me permettrait de progresser sur les variables tableau.
J'ai d'énormes lacunes dans ce domaine et c'est surtout pour ne pas rester sur un goût d'inachevé.

Au plaisir JCGL
Merci Cibleo

Pour votre info, le code initial de Job75 ici :
https://www.excel-downloads.com/threads/inserer-feuilles-et-nommer-automatiquement.128392/
 
Dernière édition:
Vote positif 0 Vote négatif
cibleo

cibleo

XLDnaute Impliqué
Bonjour à tous,
Bonjour JCGL,

Voici ma version moins épurée :rolleyes:

VB: 
Sub FeuillesSemaines1()
Dim Deb As Long, Fin As Long, i As Long, n As Byte, Tablo(1 To 53, 1 To 2), Sem As Byte, Nom As String, Nom1 As String
Dim tablo1(1 To 53, 1 To 7), x As Integer, y As Byte, k As Byte, j As Byte, Lig As Byte
Deb = DateSerial(2010, 12, 27) 'du Lundi 27 décembre 2010
Fin = DateSerial(2012, 1, 1) 'au Dimanche 01 janvier 2012 soit 53 semaines
For y = 1 To 53
For k = 1 To 7
tablo1(y, k) = Format(Deb + x, "ddd dd mmm yy")
x = x + 1
Next k
Next y
For i = Deb To Fin
If i = Deb Or Weekday(i) = 2 Then n = n + 1: Tablo(n, 1) = Format(i, "dd mmm yy")
If i = Date Then Sem = n
If i = Fin Or Weekday(i) = 1 Then Tablo(n, 2) = Format(i, "dd mmm yy")
Next
Application.ScreenUpdating = False
On Error Resume Next
For i = 1 To n
Nom = "Semaine " & Tablo(i, 1) & " - " & Tablo(i, 2)
Nom1 = "Semaine du " & Format(Tablo(i, 1), "dddd dd mmmm yyyy") & " au " & Format(Tablo(i, 2), "dddd dd mmmm yyyy")
Nom = Sheets(Nom).Name
If Err Then
Err = 0
Sheets("Modele").Copy after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = Nom
Sheets(Sheets.Count).[B1] = Nom1
j = 1
For Lig = 4 To 10
Sheets(Sheets.Count).Range("A" & Lig) = tablo1(i, j)
j = j + 1
Next Lig
End If
Next
Sheets("Semaine " & Tablo(Sem, 1) & " - " & Tablo(Sem, 2)).Select 'semaine en cours
End Sub

Cibleo
 
Vote positif 0 Vote négatif

Discussions similaires

Nicolas JACQUIN
  • Question
XL 2019 Fusionner jusqu'à dernière colonne contenant
Réponses
8
Affichages
583
TooFatBoy
TooFatBoy
Nicolas JACQUIN
  • Question
XL 2021 Exportation feuille msgbox yes no avec module Thisworkbook
2
Réponses
21
Affichages
889
Nicolas JACQUIN
Nicolas JACQUIN
N
  • Question
Microsoft 365 Recherche dans un tableau structuré à partir d'une TextBox
Réponses
11
Affichages
259
NONO14
N
G
  • Résolu(e)
XL 2021 VBA dates au mauvais format
Réponses
5
Affichages
208
vgendron
vgendron
M
  • Question
Microsoft 365 Macro VBA supprimer une colonne
Réponses
5
Affichages
319
marie3107
M
S
  • Résolu(e)
XL 2019 Problème de remplissage cellule en vba
Réponses
5
Affichages
319
snoopy07
S
patricktoulon
  • Question
Autres la fonction similaire
Réponses
11
Affichages
344
patricktoulon
patricktoulon
chris6999
  • Question
Microsoft 365 Boucle VB pour supprimer les caractères spéciaux et numériques d'une chaîne
Réponses
5
Affichages
348
patricktoulon
patricktoulon
A
  • Question
Insérer un copier / coller
Réponses
0
Affichages
273
aziz
A
N
  • Résolu(e)
Microsoft 365 Mettre la 4ème colonne d'une ListBox au format [h]:mm
3 4 5
Réponses
68
Affichages
1 K
NONO14
N

Membres actuellement en ligne

11 membres et 138 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 654
Messages
2 111 598
Membres
111 215
dernier inscrit
fateh