Générer des repos par critères

Novice avance !?

XLDnaute Occasionnel
bonjour,

je ne sais pas si une formule fait cela ou s'il faut passer par vba ?

soit :
- un calendrier d'une année (ici 2013)
- 6 groupe de repos (100 - 200 - 300 - 400 - 500 - 600)
- des repos RR tous les 6 jours pour chacun des groupes (lundi -> dimanche -> vendredi...)
- si le 1er RR du groupe 100 est le mardi 01/01/2013 , le groupe 200 aura son 1er repos RR le mardi 02/01/2013 , etc...

j'aimerais pouvoir générer ce calendrier de repos RR pour les 6 groupes de repos du 01/01/2013 au 31/12/2013 .
le fichier excel joint est plus parlant peut-être !?

merci pour votre aide à venir

bonne soirée
 

Pièces jointes

  • Classeur1.xls
    21.5 KB · Affichages: 43
  • Classeur1.xls
    21.5 KB · Affichages: 46
  • Classeur1.xls
    21.5 KB · Affichages: 43

Novice avance !?

XLDnaute Occasionnel
Re : Générer des repos par critères

bonjour,

voici le code vba que je viens de me créer.

y aurait-il une manière de simplifier le code ou de l'améliorer svp ?

merci
bonne journée

Dim i As Long
Dim j As Long

For i = 5 To 11 ' 6 groupes de repos
For j = 3 To 367 ' jusqu'à fin 2013

If i = 9 Then j = j + 1
If i = 10 Then j = j + 2
If i = 11 Then j = j + 3
If i = 12 Then j = j + 4
If i = 13 Then j = j + 5

If j > 374 Then GoTo suite
Cells(j, i) = "RR"

suite:
If i = 8 Then j = j + 5
If i = 9 Then j = j + 4
If i = 10 Then j = j + 3
If i = 11 Then j = j + 2
If i = 12 Then j = j + 1

Next j
Next i
 

ralph45

XLDnaute Impliqué
Re : Générer des repos par critères

Bonjour Novice avance !?

Si j'ai bien compris, pourquoi du VBA ? Ta demande est une suite logique et continue.
Aussi, une simple formule devrait convenir.
A coller en E9 :
=SI(ESTVIDE(E3);0;E3)
Copier-coller sur la ligne, puis tirer vers le bas ou copiage-collage spécial de formule (voir PJ)...

A+
 

Pièces jointes

  • NoviceAvance.xls
    32 KB · Affichages: 41
Dernière édition:

jpb388

XLDnaute Accro
Re : Générer des repos par critères

Bonjour à tous
autre version vba
Code:
Sub MettreRR()
Dim RR1 As String, RR2 As String
Dim RR3 As String, RR4 As String
Dim RR5 As String, RR6 As String
Dim i As Integer
i = 3
RR1 = Range("a3").Text
RR2 = Range("a4").Text
RR3 = Range("a5").Text
RR4 = Range("a6").Text
RR5 = Range("a7").Text
RR6 = Range("a8").Text

Do
Select Case Range("a" & i).Text
    Case RR1
        Range("e" & i) = "RR"
        RR1 = Cells(i + 6, 1).Text
    Case RR2
        Range("f" & i) = "RR"
        RR2 = Cells(i + 6, 1).Text
    Case RR3
        Range("g" & i) = "RR"
        RR3 = Cells(i + 6, 1).Text
    Case RR4
        Range("h" & i) = "RR"
        RR4 = Cells(i + 6, 1).Text
    Case RR5
        Range("i" & i) = "RR"
        RR5 = Cells(i + 6, 1).Text
    Case RR6
        Range("j" & i) = "RR"
        RR6 = Cells(i + 6, 1).Text
End Select
i = i + 1
Loop Until Range("a" & i) = ""
End Sub