[VBA - boucle] Cycle de travail et roulement - RESOLU

[babas]

Bonjour à tous,

Je viens vers vous car là je coince. Vous trouverez le fichier en PJ.

Voici ce que je souhaite.
Sur la feuille il y a un tableau où je renseigne le roulement des salariés (de 1 à 12 semaines).
Sur la droite de ce tableau, on retrouve un semblant de calendrier. Il n'as pas de date, débute un lundi pour terminer un dimanche (au max 12 semaines).
J'ai débuter une macro avec boucle. Le but étant :

• La première semaine du tableau de roulement doit venir se positionner au début sur le "calendrier", suivie de la seconde, troisième, ... - ainsi de suite jusqu'à la dernière semaine du roulement.
• Sur ce calendrier à droite, la seconde ligne doit reprendre la seconde semaine du roulement pour terminer par la première
• La troisième ligne doit reprendre la troisième semaine du roulement puis quatrième et terminer par la seconde.
• et ainsi de suite, le but étant d'avoir un roulement complet. L'exécution risquant d'être longue je rajouterai un jolie barre de progression pour faire patienter

La macro que j'ai fait complète sans soucis la première ligne de ce calendrier avec la semaine 1 du roulement puis 2 puis 3 et ainsi de suite.
En revanche là où ça coince c'est que la seconde ligne reprend comme la précédente en commençant par la première semaine du roulement et non la deuxième. Il en est ainsi pour toutes les autres lignes.
Ce que je souhaiterai c'est que la macro fasse tout correctement comme expliqué ci dessus.

Voilà, en espérant avoir été clair, un petit coup d'œil sur le fichier devrait être plus parlant.

Merci d'avance à ceux qui m'apporteront leur lumière et merci de m'avoir lu.

 

[Paf]

Bonjour,

un essai par tableau( array)

Sub rlt_vers_cal()
Dim T, Plage, Sem As Byte, TF, DL As Integer
With Sheets("Rlt")
Sem = .Range("L1") 'Donne le nombre de semaine sur le roulement
DL = .Range("E2").End(xlDown).Row
ReDim TF(1 To DL - 1, 1 To 7 * (DL - 1))
Plage = Range("E2:K" & DL)
T = MergeArray2DVert(Plage, Plage)
For i = 1 To UBound(Plage)
    b = 0
    For j = 0 To UBound(Plage) - 1
        For jour = 1 To 7
            b = b + 1
            TF(i, b) = T(i + j, jour)
        Next
    Next
Next
.Range("M14").Resize(UBound(TF, 1), UBound(TF, 2)) = TF
End With
End Sub

dans le même module, le code de la fonction de concaténation de tableaux, empruntée à J. BOISGONTIER

Function MergeArray2DVert(a, b)
'http://boisgontierjacques.free.fr/pages_site/tableaux.htm#FusionVert2d
  maxtab1 = UBound(a)
  Dim Tbl(): ReDim Tbl(1 To UBound(a) + UBound(b), 1 To UBound(a, 2))
  For i = LBound(a) To UBound(a)
    For c = 1 To UBound(a, 2): Tbl(i, c) = a(i, c): Next
  Next i
  For i = 1 To UBound(b)
    For c = 1 To UBound(b, 2): Tbl(maxtab1 + i, c) = b(i, c): Next
  Next i
  MergeArray2DVert = Tbl
End Function

 

[babas]

Bonsoir,

Merci, ça semble fonctionner, je regarde de plus près cette nuit.
Une macro que je ne connais pas, ça va me permettre de bien tout voir pour la reproduire.

Merci

 

[babas]

C'est parfait, serait-il trop demandé d'avoir les commentaires sur la macro, j'ai du mal à comprendre le cheminement.

 

[Paf]

Le principe :

pour chaque ligne de la plage de données utiles (plage) on va copier les 8 lignes (y compris la ligne courante) de données dans le Tableau Final (TF).

pour la première ligne on va donc copier les lignes 1 à 8.
pour la deuxième on copiera les lignes 2 à 9.
mais comme plage ne contient que 8 lignes ça ne marcherait pas.
en copiant deux fois la plage dans le tableau T, on obtient 16 lignes et donc pour la deuxième ligne on pourra copier les lignes 2 à 9 (la ligne 9 étant la copie de la ligne 1)
pour la ligne 3 on copie les lignes 3 à 10 ( les lignes 9 et 10 étant les copies des lignes 1 et 2)
pour la ligne 4 .....

Sub rlt_vers_cal()
Dim T, Plage, Sem As Byte, TF, DL As Integer
With Sheets("Rlt")
Sem = .Range("L1") 'Donne le nombre de semaine sur le roulement
DL = .Range("E2").End(xlDown).Row 'donne le N° dernière ligne utile dans le classeur ligne 9
ReDim TF(1 To DL - 1, 1 To 7 * (DL - 1))  'création d'un tableau de 8 lignes(semaines) sur 7x8 jours
Plage = Range("E2:K" & DL) ' on mets en tableau les données à copier
T = MergeArray2DVert(Plage, Plage) 'on copie les mêmes données à la suite des premières
For i = 1 To UBound(Plage)  ' pour chacune des 8 (dans l'exemple) semaines
    b = 0    'compteur  de jours pour remplir le tableau TF
    For j = 0 To UBound(Plage) - 1 ' pour chaque lignes de la plage
        For jour = 1 To 7           ' pour chaque jour
            b = b + 1                   'on incrémente l'indice du tableau TF
            TF(i, b) = T(i + j, jour) ' on copie dans TF les données de la plage
        Next
    Next
Next
.Range("M14").Resize(UBound(TF, 1), UBound(TF, 2)) = TF 'on copie dans la feuille le tableau TF
End With
End Sub

Si ce n'est pas clair (et ça ne l'est certainement pas trop) j'essaierai de mettre un schéma.

A+

 

[babas]

Au top, merci beaucoup, ce n'est pas clair (c'est des macros ce n'est jamais vraiment clair ) mais je comprends. Je vais regarder de plus près la fonction de J. BOISGONTIER .

Merci beaucoup

 

[Paf]

Un petit shéma de principe :

 

[babas]

Merci beaucoup