Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

Gestion des repos pour Daniel

3 réponses
Avatar
squeepy
Bonjour,
avec le post : aide pour macro, insertion de cellules auto
tu m'avais bien aidé pour insérer des personnes dans un tableau en fonction
de leur emploi, repos,...
je te rappelle le code :
Private Sub Cmd_Distribuer_Click()
Dim TabprovB, TabprovF, IndB As Integer, IndF As Integer
Dim Plage As Range, c As Range, TabBoul(100, 2) As String, TabFleur(100,
2) As String
Dim Fleuriste As Long, Boulanger As Long
Dim x As Long, y As Long, sh As Worksheet
Dim ResJour As String
ResJour = "lundi"
Set Plage = Sheets("Personnes").Range("A1",
Sheets("Personnes").Range("A65536").End(xlUp))
For Each c In Plage
If c.Offset(0, 1) = "Boulanger" Then
TabBoul(Boulanger, 0) = c.Value
TabBoul(Boulanger, 1) = c.Offset(0, 1).Value
TabBoul(Boulanger, 2) =
Application.Index(Sheets("Personnes").Range("C1:H1"), 1, _
Application.Match("Repos", Sheets("Personnes").Range(c.Offset(0,
2), c.Offset(0, 7)), 0))
Boulanger = Boulanger + 1
ElseIf c.Offset(0, 1) = "Fleuriste" Then
TabFleur(Fleuriste, 0) = c.Value
TabFleur(Fleuriste, 1) = c.Offset(0, 1).Value
TabFleur(Fleuriste, 2) =
Application.Index(Sheets("Personnes").Range("C1:H1"), 1, _
Application.Match("Repos", Sheets("Personnes").Range(c.Offset(0,
2), c.Offset(0, 7)), 0))
Fleuriste = Fleuriste + 1
End If
Next c
' Traitement du lundi
Range("C5:C17").ClearContents
Range("G5:G17").ClearContents
Range("K5:K17").ClearContents
TabprovF = TabFleur
TabprovB = TabBoul
Randomize
For Each c In Union(Range("A5:A17"), Range("E5:E17"), Range("I5:I17"))
If IsNumeric(Application.Match(c, Sheets("Personnes").Range("J:J"),
0)) Then
Do While c.Offset(0, 2) = ""
IndF = Int(Fleuriste * Rnd)
If TabprovF(IndF, 2) <> "lundi" Then
c.Offset(0, 2) = TabprovF(IndF, 0)
End If
Loop
TabprovF(IndF, 0) = ""
ElseIf IsNumeric(Application.Match(c,
Sheets("Personnes").Range("K:K"), 0)) Then
Do While c.Offset(0, 2) = ""
IndB = Int(Fleuriste * Rnd)
If TabprovB(IndB, 2) <> "lundi" Then
c.Offset(0, 2) = TabprovB(IndB, 0)
End If
Loop
TabprovB(IndB, 0) = ""
End If
Next c

'Traitement des autres jours
For Each sh In Sheets
If sh.Name <> "Personnes" And sh.Name <> "Lundi" Then
With sh
.Range("C5:C17").ClearContents
.Range("G5:G17").ClearContents
.Range("K5:K17").ClearContents
TabprovF = TabFleur
TabprovB = TabBoul
Randomize
For Each c In Union(.Range("A5:A17"), .Range("E5:E17"),
.Range("I5:I17"))
If IsNumeric(Application.Match(c,
Sheets("Personnes").Range("J:J"), 0)) Then
Do While c.Offset(0, 2) = ""
IndF = Int(Fleuriste * Rnd)
If TabprovF(IndF, 2) <> LCase(sh.Name) And _
TabprovF(IndF, 0) <> ResJour Then
c.Offset(0, 2) = TabprovF(IndF, 0)
End If
Loop
TabprovF(IndF, 0) = ""
ElseIf IsNumeric(Application.Match(c,
Sheets("Personnes").Range("K:K"), 0)) Then
Do While c.Offset(0, 2) = ""
IndB = Int(Fleuriste * Rnd)
If TabprovB(IndB, 2) <> "lundi" Then
c.Offset(0, 2) = TabprovB(IndB, 0)
End If
Loop
TabprovB(IndB, 0) = ""
End If
Next c
ResJour = LCase(sh.Name)
End With
End If
Next sh
End Sub

Private Sub Cmd_Repos_Click()
Dim c As Range, Plage As Range, sh As Worksheet
Dim Ctr As Integer, Jour
Set Plage = Sheets("Personnes").Range("A2", _
Sheets("Personnes").Range("A65536").End(xlUp))
For Each sh In Sheets
If sh.Name <> "Personnes" Then
sh.Range("B19:B2000").ClearContents
For Each c In Plage
Jour = Application.Match("Repos", _
Sheets("Personnes").Range(c.Offset(0, 2), c.Offset(0,
7)), 0)
Jour = Application.Index(Sheets("Personnes").Range("C1:H1"),
1, Jour)
If LCase(Jour) = LCase(sh.Name) Then
sh.Range("B19").Offset(Ctr, 0) = c.Value
Ctr = Ctr + 1
End If
Next c
End If
Ctr = 0
Next sh
End Sub

J'ai un petit souci avec les repos :
Pour le repos, ca ne gere qu'une journée par semaine, peut on faire en sorte
que ça en gere plus?
ex : si pour tutu, j'ai un repos lundi et mardi
et bien il ne sera affecté que sur la feuille lundi et non pas mardi
--
Merci de votre aide

3 réponses

Avatar
Daniel
Bonjour.
Remplace la macro :
Private Sub Cmd_Repos_Click()
par :

Private Sub Cmd_Repos_Click()
Dim c As Range, Plage As Range, sh As Worksheet
Dim Ctr As Integer, Jour, Personne
Set Plage = Sheets("Personnes").Range("A2", _
Sheets("Personnes").Range("A65536").End(xlUp))
For Each sh In Sheets
If sh.Name <> "Personnes" Then
sh.Range("B19:B2000").ClearContents
For Each c In Plage
Personne = c.Row - 1
Jour = Application.Match(LCase(sh.Name), _
Sheets("Personnes").Range("C1:H1"), 0) + 2
If Application.Index(Plage.Resize(, 8), Personne, Jour) _
= "Repos" Then
sh.Range("B19").Offset(Ctr, 0) = c.Value
Ctr = Ctr + 1
End If
Next c
End If
Ctr = 0
Next sh
End Sub

Cordialement.
Daniel
"squeepy" a écrit dans le message de
news:
Bonjour,
avec le post : aide pour macro, insertion de cellules auto
tu m'avais bien aidé pour insérer des personnes dans un tableau en
fonction
de leur emploi, repos,...
je te rappelle le code :
Private Sub Cmd_Distribuer_Click()
Dim TabprovB, TabprovF, IndB As Integer, IndF As Integer
Dim Plage As Range, c As Range, TabBoul(100, 2) As String,
TabFleur(100,
2) As String
Dim Fleuriste As Long, Boulanger As Long
Dim x As Long, y As Long, sh As Worksheet
Dim ResJour As String
ResJour = "lundi"
Set Plage = Sheets("Personnes").Range("A1",
Sheets("Personnes").Range("A65536").End(xlUp))
For Each c In Plage
If c.Offset(0, 1) = "Boulanger" Then
TabBoul(Boulanger, 0) = c.Value
TabBoul(Boulanger, 1) = c.Offset(0, 1).Value
TabBoul(Boulanger, 2) > Application.Index(Sheets("Personnes").Range("C1:H1"), 1, _
Application.Match("Repos",
Sheets("Personnes").Range(c.Offset(0,
2), c.Offset(0, 7)), 0))
Boulanger = Boulanger + 1
ElseIf c.Offset(0, 1) = "Fleuriste" Then
TabFleur(Fleuriste, 0) = c.Value
TabFleur(Fleuriste, 1) = c.Offset(0, 1).Value
TabFleur(Fleuriste, 2) > Application.Index(Sheets("Personnes").Range("C1:H1"), 1, _
Application.Match("Repos",
Sheets("Personnes").Range(c.Offset(0,
2), c.Offset(0, 7)), 0))
Fleuriste = Fleuriste + 1
End If
Next c
' Traitement du lundi
Range("C5:C17").ClearContents
Range("G5:G17").ClearContents
Range("K5:K17").ClearContents
TabprovF = TabFleur
TabprovB = TabBoul
Randomize
For Each c In Union(Range("A5:A17"), Range("E5:E17"), Range("I5:I17"))
If IsNumeric(Application.Match(c, Sheets("Personnes").Range("J:J"),
0)) Then
Do While c.Offset(0, 2) = ""
IndF = Int(Fleuriste * Rnd)
If TabprovF(IndF, 2) <> "lundi" Then
c.Offset(0, 2) = TabprovF(IndF, 0)
End If
Loop
TabprovF(IndF, 0) = ""
ElseIf IsNumeric(Application.Match(c,
Sheets("Personnes").Range("K:K"), 0)) Then
Do While c.Offset(0, 2) = ""
IndB = Int(Fleuriste * Rnd)
If TabprovB(IndB, 2) <> "lundi" Then
c.Offset(0, 2) = TabprovB(IndB, 0)
End If
Loop
TabprovB(IndB, 0) = ""
End If
Next c

'Traitement des autres jours
For Each sh In Sheets
If sh.Name <> "Personnes" And sh.Name <> "Lundi" Then
With sh
.Range("C5:C17").ClearContents
.Range("G5:G17").ClearContents
.Range("K5:K17").ClearContents
TabprovF = TabFleur
TabprovB = TabBoul
Randomize
For Each c In Union(.Range("A5:A17"), .Range("E5:E17"),
.Range("I5:I17"))
If IsNumeric(Application.Match(c,
Sheets("Personnes").Range("J:J"), 0)) Then
Do While c.Offset(0, 2) = ""
IndF = Int(Fleuriste * Rnd)
If TabprovF(IndF, 2) <> LCase(sh.Name) And _
TabprovF(IndF, 0) <> ResJour Then
c.Offset(0, 2) = TabprovF(IndF, 0)
End If
Loop
TabprovF(IndF, 0) = ""
ElseIf IsNumeric(Application.Match(c,
Sheets("Personnes").Range("K:K"), 0)) Then
Do While c.Offset(0, 2) = ""
IndB = Int(Fleuriste * Rnd)
If TabprovB(IndB, 2) <> "lundi" Then
c.Offset(0, 2) = TabprovB(IndB, 0)
End If
Loop
TabprovB(IndB, 0) = ""
End If
Next c
ResJour = LCase(sh.Name)
End With
End If
Next sh
End Sub

Private Sub Cmd_Repos_Click()
Dim c As Range, Plage As Range, sh As Worksheet
Dim Ctr As Integer, Jour
Set Plage = Sheets("Personnes").Range("A2", _
Sheets("Personnes").Range("A65536").End(xlUp))
For Each sh In Sheets
If sh.Name <> "Personnes" Then
sh.Range("B19:B2000").ClearContents
For Each c In Plage
Jour = Application.Match("Repos", _
Sheets("Personnes").Range(c.Offset(0, 2), c.Offset(0,
7)), 0)
Jour =
Application.Index(Sheets("Personnes").Range("C1:H1"),
1, Jour)
If LCase(Jour) = LCase(sh.Name) Then
sh.Range("B19").Offset(Ctr, 0) = c.Value
Ctr = Ctr + 1
End If
Next c
End If
Ctr = 0
Next sh
End Sub

J'ai un petit souci avec les repos :
Pour le repos, ca ne gere qu'une journée par semaine, peut on faire en
sorte
que ça en gere plus?
ex : si pour tutu, j'ai un repos lundi et mardi
et bien il ne sera affecté que sur la feuille lundi et non pas mardi
--
Merci de votre aide


Avatar
squeepy
merci, merci, merci




Bonjour.
Remplace la macro :
Private Sub Cmd_Repos_Click()
par :

Private Sub Cmd_Repos_Click()
Dim c As Range, Plage As Range, sh As Worksheet
Dim Ctr As Integer, Jour, Personne
Set Plage = Sheets("Personnes").Range("A2", _
Sheets("Personnes").Range("A65536").End(xlUp))
For Each sh In Sheets
If sh.Name <> "Personnes" Then
sh.Range("B19:B2000").ClearContents
For Each c In Plage
Personne = c.Row - 1
Jour = Application.Match(LCase(sh.Name), _
Sheets("Personnes").Range("C1:H1"), 0) + 2
If Application.Index(Plage.Resize(, 8), Personne, Jour) _
= "Repos" Then
sh.Range("B19").Offset(Ctr, 0) = c.Value
Ctr = Ctr + 1
End If
Next c
End If
Ctr = 0
Next sh
End Sub

Cordialement.
Daniel
"squeepy" a écrit dans le message de
news:
Bonjour,
avec le post : aide pour macro, insertion de cellules auto
tu m'avais bien aidé pour insérer des personnes dans un tableau en
fonction
de leur emploi, repos,...
je te rappelle le code :
Private Sub Cmd_Distribuer_Click()
Dim TabprovB, TabprovF, IndB As Integer, IndF As Integer
Dim Plage As Range, c As Range, TabBoul(100, 2) As String,
TabFleur(100,
2) As String
Dim Fleuriste As Long, Boulanger As Long
Dim x As Long, y As Long, sh As Worksheet
Dim ResJour As String
ResJour = "lundi"
Set Plage = Sheets("Personnes").Range("A1",
Sheets("Personnes").Range("A65536").End(xlUp))
For Each c In Plage
If c.Offset(0, 1) = "Boulanger" Then
TabBoul(Boulanger, 0) = c.Value
TabBoul(Boulanger, 1) = c.Offset(0, 1).Value
TabBoul(Boulanger, 2) > > Application.Index(Sheets("Personnes").Range("C1:H1"), 1, _
Application.Match("Repos",
Sheets("Personnes").Range(c.Offset(0,
2), c.Offset(0, 7)), 0))
Boulanger = Boulanger + 1
ElseIf c.Offset(0, 1) = "Fleuriste" Then
TabFleur(Fleuriste, 0) = c.Value
TabFleur(Fleuriste, 1) = c.Offset(0, 1).Value
TabFleur(Fleuriste, 2) > > Application.Index(Sheets("Personnes").Range("C1:H1"), 1, _
Application.Match("Repos",
Sheets("Personnes").Range(c.Offset(0,
2), c.Offset(0, 7)), 0))
Fleuriste = Fleuriste + 1
End If
Next c
' Traitement du lundi
Range("C5:C17").ClearContents
Range("G5:G17").ClearContents
Range("K5:K17").ClearContents
TabprovF = TabFleur
TabprovB = TabBoul
Randomize
For Each c In Union(Range("A5:A17"), Range("E5:E17"), Range("I5:I17"))
If IsNumeric(Application.Match(c, Sheets("Personnes").Range("J:J"),
0)) Then
Do While c.Offset(0, 2) = ""
IndF = Int(Fleuriste * Rnd)
If TabprovF(IndF, 2) <> "lundi" Then
c.Offset(0, 2) = TabprovF(IndF, 0)
End If
Loop
TabprovF(IndF, 0) = ""
ElseIf IsNumeric(Application.Match(c,
Sheets("Personnes").Range("K:K"), 0)) Then
Do While c.Offset(0, 2) = ""
IndB = Int(Fleuriste * Rnd)
If TabprovB(IndB, 2) <> "lundi" Then
c.Offset(0, 2) = TabprovB(IndB, 0)
End If
Loop
TabprovB(IndB, 0) = ""
End If
Next c

'Traitement des autres jours
For Each sh In Sheets
If sh.Name <> "Personnes" And sh.Name <> "Lundi" Then
With sh
.Range("C5:C17").ClearContents
.Range("G5:G17").ClearContents
.Range("K5:K17").ClearContents
TabprovF = TabFleur
TabprovB = TabBoul
Randomize
For Each c In Union(.Range("A5:A17"), .Range("E5:E17"),
.Range("I5:I17"))
If IsNumeric(Application.Match(c,
Sheets("Personnes").Range("J:J"), 0)) Then
Do While c.Offset(0, 2) = ""
IndF = Int(Fleuriste * Rnd)
If TabprovF(IndF, 2) <> LCase(sh.Name) And _
TabprovF(IndF, 0) <> ResJour Then
c.Offset(0, 2) = TabprovF(IndF, 0)
End If
Loop
TabprovF(IndF, 0) = ""
ElseIf IsNumeric(Application.Match(c,
Sheets("Personnes").Range("K:K"), 0)) Then
Do While c.Offset(0, 2) = ""
IndB = Int(Fleuriste * Rnd)
If TabprovB(IndB, 2) <> "lundi" Then
c.Offset(0, 2) = TabprovB(IndB, 0)
End If
Loop
TabprovB(IndB, 0) = ""
End If
Next c
ResJour = LCase(sh.Name)
End With
End If
Next sh
End Sub

Private Sub Cmd_Repos_Click()
Dim c As Range, Plage As Range, sh As Worksheet
Dim Ctr As Integer, Jour
Set Plage = Sheets("Personnes").Range("A2", _
Sheets("Personnes").Range("A65536").End(xlUp))
For Each sh In Sheets
If sh.Name <> "Personnes" Then
sh.Range("B19:B2000").ClearContents
For Each c In Plage
Jour = Application.Match("Repos", _
Sheets("Personnes").Range(c.Offset(0, 2), c.Offset(0,
7)), 0)
Jour =
Application.Index(Sheets("Personnes").Range("C1:H1"),
1, Jour)
If LCase(Jour) = LCase(sh.Name) Then
sh.Range("B19").Offset(Ctr, 0) = c.Value
Ctr = Ctr + 1
End If
Next c
End If
Ctr = 0
Next sh
End Sub

J'ai un petit souci avec les repos :
Pour le repos, ca ne gere qu'une journée par semaine, peut on faire en
sorte
que ça en gere plus?
ex : si pour tutu, j'ai un repos lundi et mardi
et bien il ne sera affecté que sur la feuille lundi et non pas mardi
--
Merci de votre aide







Avatar
squeepy
encore merci
une derniere question :
avec le programme, quand il n'y a pas assez de monde, ca boucle à l'infini
et c'est normal je pense.
Est ce qu'il n'y a pas moyen de laisser les champs à blanc si il n'y a pas
assez de monde et arreter la boucle?
--
Merci de votre aide



Bonjour.
Remplace la macro :
Private Sub Cmd_Repos_Click()
par :

Private Sub Cmd_Repos_Click()
Dim c As Range, Plage As Range, sh As Worksheet
Dim Ctr As Integer, Jour, Personne
Set Plage = Sheets("Personnes").Range("A2", _
Sheets("Personnes").Range("A65536").End(xlUp))
For Each sh In Sheets
If sh.Name <> "Personnes" Then
sh.Range("B19:B2000").ClearContents
For Each c In Plage
Personne = c.Row - 1
Jour = Application.Match(LCase(sh.Name), _
Sheets("Personnes").Range("C1:H1"), 0) + 2
If Application.Index(Plage.Resize(, 8), Personne, Jour) _
= "Repos" Then
sh.Range("B19").Offset(Ctr, 0) = c.Value
Ctr = Ctr + 1
End If
Next c
End If
Ctr = 0
Next sh
End Sub

Cordialement.
Daniel
"squeepy" a écrit dans le message de
news:
Bonjour,
avec le post : aide pour macro, insertion de cellules auto
tu m'avais bien aidé pour insérer des personnes dans un tableau en
fonction
de leur emploi, repos,...
je te rappelle le code :
Private Sub Cmd_Distribuer_Click()
Dim TabprovB, TabprovF, IndB As Integer, IndF As Integer
Dim Plage As Range, c As Range, TabBoul(100, 2) As String,
TabFleur(100,
2) As String
Dim Fleuriste As Long, Boulanger As Long
Dim x As Long, y As Long, sh As Worksheet
Dim ResJour As String
ResJour = "lundi"
Set Plage = Sheets("Personnes").Range("A1",
Sheets("Personnes").Range("A65536").End(xlUp))
For Each c In Plage
If c.Offset(0, 1) = "Boulanger" Then
TabBoul(Boulanger, 0) = c.Value
TabBoul(Boulanger, 1) = c.Offset(0, 1).Value
TabBoul(Boulanger, 2) > > Application.Index(Sheets("Personnes").Range("C1:H1"), 1, _
Application.Match("Repos",
Sheets("Personnes").Range(c.Offset(0,
2), c.Offset(0, 7)), 0))
Boulanger = Boulanger + 1
ElseIf c.Offset(0, 1) = "Fleuriste" Then
TabFleur(Fleuriste, 0) = c.Value
TabFleur(Fleuriste, 1) = c.Offset(0, 1).Value
TabFleur(Fleuriste, 2) > > Application.Index(Sheets("Personnes").Range("C1:H1"), 1, _
Application.Match("Repos",
Sheets("Personnes").Range(c.Offset(0,
2), c.Offset(0, 7)), 0))
Fleuriste = Fleuriste + 1
End If
Next c
' Traitement du lundi
Range("C5:C17").ClearContents
Range("G5:G17").ClearContents
Range("K5:K17").ClearContents
TabprovF = TabFleur
TabprovB = TabBoul
Randomize
For Each c In Union(Range("A5:A17"), Range("E5:E17"), Range("I5:I17"))
If IsNumeric(Application.Match(c, Sheets("Personnes").Range("J:J"),
0)) Then
Do While c.Offset(0, 2) = ""
IndF = Int(Fleuriste * Rnd)
If TabprovF(IndF, 2) <> "lundi" Then
c.Offset(0, 2) = TabprovF(IndF, 0)
End If
Loop
TabprovF(IndF, 0) = ""
ElseIf IsNumeric(Application.Match(c,
Sheets("Personnes").Range("K:K"), 0)) Then
Do While c.Offset(0, 2) = ""
IndB = Int(Fleuriste * Rnd)
If TabprovB(IndB, 2) <> "lundi" Then
c.Offset(0, 2) = TabprovB(IndB, 0)
End If
Loop
TabprovB(IndB, 0) = ""
End If
Next c

'Traitement des autres jours
For Each sh In Sheets
If sh.Name <> "Personnes" And sh.Name <> "Lundi" Then
With sh
.Range("C5:C17").ClearContents
.Range("G5:G17").ClearContents
.Range("K5:K17").ClearContents
TabprovF = TabFleur
TabprovB = TabBoul
Randomize
For Each c In Union(.Range("A5:A17"), .Range("E5:E17"),
.Range("I5:I17"))
If IsNumeric(Application.Match(c,
Sheets("Personnes").Range("J:J"), 0)) Then
Do While c.Offset(0, 2) = ""
IndF = Int(Fleuriste * Rnd)
If TabprovF(IndF, 2) <> LCase(sh.Name) And _
TabprovF(IndF, 0) <> ResJour Then
c.Offset(0, 2) = TabprovF(IndF, 0)
End If
Loop
TabprovF(IndF, 0) = ""
ElseIf IsNumeric(Application.Match(c,
Sheets("Personnes").Range("K:K"), 0)) Then
Do While c.Offset(0, 2) = ""
IndB = Int(Fleuriste * Rnd)
If TabprovB(IndB, 2) <> "lundi" Then
c.Offset(0, 2) = TabprovB(IndB, 0)
End If
Loop
TabprovB(IndB, 0) = ""
End If
Next c
ResJour = LCase(sh.Name)
End With
End If
Next sh
End Sub

Private Sub Cmd_Repos_Click()
Dim c As Range, Plage As Range, sh As Worksheet
Dim Ctr As Integer, Jour
Set Plage = Sheets("Personnes").Range("A2", _
Sheets("Personnes").Range("A65536").End(xlUp))
For Each sh In Sheets
If sh.Name <> "Personnes" Then
sh.Range("B19:B2000").ClearContents
For Each c In Plage
Jour = Application.Match("Repos", _
Sheets("Personnes").Range(c.Offset(0, 2), c.Offset(0,
7)), 0)
Jour =
Application.Index(Sheets("Personnes").Range("C1:H1"),
1, Jour)
If LCase(Jour) = LCase(sh.Name) Then
sh.Range("B19").Offset(Ctr, 0) = c.Value
Ctr = Ctr + 1
End If
Next c
End If
Ctr = 0
Next sh
End Sub

J'ai un petit souci avec les repos :
Pour le repos, ca ne gere qu'une journée par semaine, peut on faire en
sorte
que ça en gere plus?
ex : si pour tutu, j'ai un repos lundi et mardi
et bien il ne sera affecté que sur la feuille lundi et non pas mardi
--
Merci de votre aide