XL 2016 Remplir un planning en fonction de 2 données

R

Ralf94

XLDnaute Nouveau
Bonjour,

Je suis novice en Excel, et je galère depuis quelques jours sur mon fichier.
Je vais joindre à ma demande, le fichier comme ça, ça sera plus parlant, avec une photo du résultat escompté.

Je voudrais savoir comment faire pour marquer sur ma feuille "planning case" un numéro, qui correspondra à l'une des prestations qui sont sur la feuille "Avancement" ex: faïence=1 ; élec=2;..., en fonction de la personne qui se trouve dans la feuille "avancement" et de la date inscrite à coter et par rapport au travail.

Je vous remercie pour votre aide.
 

Pièces jointes

  • aide.xlsx
    188 KB · Affichages: 91
  • resultat escompte.png
    resultat escompte.png
    119.1 KB · Affichages: 43
Trier par date Trier par votes
vgendron

vgendron

XLDnaute Barbatruc
Hello

un essai avec ce code
PS: j'ai déjà pris en compte le cas ou la personne est sur un atelier pendant une période complète (avec colonne FIN renseignée..

VB: 
Sub planning()

NbPersonnes = Range("A" & Rows.Count).End(xlUp).Row - 3

For i = 1 To NbPersonnes
    Employé = Range("A" & i + 3)
    With Sheets("Planning case")
        Set ici = .Range("A8").Resize(NbPersonnes).Find(Employé, lookat:=xlWhole)
        If Not ici Is Nothing Then
            Ligne = ici.Row
        End If
    End With
    For j = 3 To 9 Step 2
        Atelier = Cells(1, j)
        Debut = Cells(i + 3, j)
        Fin = Cells(i + 3, j + 1)
        With Sheets("Planning case")
       
            If Debut <> "" Then
                Set Dela = .Rows(7).Find(Debut, LookIn:=xlValues)
                If Not Dela Is Nothing Then
                    ColDebut = Dela.Column
                End If
            End If
            If Fin <> "" Then
                Set ALa = .Rows(7).Find(Fin, LookIn:=xlValues)
                If Not ALa Is Nothing Then
                    ColFin = ALa.Column
                End If
            Else: ColFin = ColDebut
            End If
            If Debut <> "" Then
                .Cells(Ligne, ColDebut) = Atelier
            End If
            If ColDebut <> ColFin Then
                .Range(.Cells(Ligne, ColDebut), .Cells(Ligne, ColFin)).FillRight
            End If
        End With
    Next j
Next i

End Sub
 
Vote positif 0 Vote négatif
vgendron

vgendron

XLDnaute Barbatruc
Re

modif dans la pièce jointe
pour colorer les cellules
et traiter les cas ou les dates n'existent pas

sans doute (très certainement) d'autres cas à traiter (ex: quelqu'un qui n'existe pas)..
c'est un début
 

Pièces jointes

  • aide.xlsm
    214.4 KB · Affichages: 41
Vote positif 0 Vote négatif
vgendron

vgendron

XLDnaute Barbatruc
Hello
en fait ca fonctionne bien pour peu que le bouton "Go" soit placé dans la bonne feuille... "Avancement"
je m'a gourré :-D
j'ai donc remis le bouton Go dans la feuille Avancement, et corrigé le code pour que sa place n'ait finalement pas d'importance..

donc.
1) soit tu changes le bouton de place et tu laisses le code comme il est
2) soit tu laisses le bouton dans la feuille Planning Case et tu remplaces le code par celui ci:
VB: 
Sub planning()

NbPersonnes = Sheets("Avancement").Range("A" & Rows.Count).End(xlUp).Row - 3

For i = 1 To NbPersonnes
    Employé = Sheets("Avancement").Range("A" & i + 3)
    With Sheets("Planning case")
        Set ici = .Range("A8").Resize(NbPersonnes).Find(Employé, lookat:=xlWhole)
        If Not ici Is Nothing Then
            Ligne = ici.Row
        End If
    End With
    For j = 3 To 9 Step 2
        Atelier = Sheets("Avancement").Cells(1, j)
        couleur = Sheets("Avancement").Cells(1, j).Interior.ColorIndex
        Debut = Sheets("Avancement").Cells(i + 3, j)
        Fin = Sheets("Avancement").Cells(i + 3, j + 1)
        With Sheets("Planning case")
       
            If Debut <> "" Then
                Set Dela = .Rows(7).Find(Debut, LookIn:=xlValues)
                If Not Dela Is Nothing Then
                    ColDebut = Dela.Column
                Else: Exit For
                End If
            End If
            If Fin <> "" Then
                Set ALa = .Rows(7).Find(Fin, LookIn:=xlValues)
                If Not ALa Is Nothing Then
                    ColFin = ALa.Column
                Else: Exit For
                End If
            Else: ColFin = ColDebut
            End If
            If Debut <> "" Then
                .Cells(Ligne, ColDebut) = Atelier
                .Cells(Ligne, ColDebut).Interior.ColorIndex = couleur
            End If
            If ColDebut <> ColFin Then
                .Range(.Cells(Ligne, ColDebut), .Cells(Ligne, ColFin)).FillRight
                .Range(.Cells(Ligne, ColDebut), .Cells(Ligne, ColFin)).Interior.ColorIndex = couleur
            End If
        End With
    Next j
Next i

End Sub

[/cdoe]
 
Vote positif 0 Vote négatif
R

Ralf94

XLDnaute Nouveau
vgendron à dit:
Hello
en fait ca fonctionne bien pour peu que le bouton "Go" soit placé dans la bonne feuille... "Avancement"
je m'a gourré :-D
j'ai donc remis le bouton Go dans la feuille Avancement, et corrigé le code pour que sa place n'ait finalement pas d'importance..

donc.
1) soit tu changes le bouton de place et tu laisses le code comme il est
2) soit tu laisses le bouton dans la feuille Planning Case et tu remplaces le code par celui ci:
VB: 
Sub planning()

NbPersonnes = Sheets("Avancement").Range("A" & Rows.Count).End(xlUp).Row - 3

For i = 1 To NbPersonnes
    Employé = Sheets("Avancement").Range("A" & i + 3)
    With Sheets("Planning case")
        Set ici = .Range("A8").Resize(NbPersonnes).Find(Employé, lookat:=xlWhole)
        If Not ici Is Nothing Then
            Ligne = ici.Row
        End If
    End With
    For j = 3 To 9 Step 2
        Atelier = Sheets("Avancement").Cells(1, j)
        couleur = Sheets("Avancement").Cells(1, j).Interior.ColorIndex
        Debut = Sheets("Avancement").Cells(i + 3, j)
        Fin = Sheets("Avancement").Cells(i + 3, j + 1)
        With Sheets("Planning case")
     
            If Debut <> "" Then
                Set Dela = .Rows(7).Find(Debut, LookIn:=xlValues)
                If Not Dela Is Nothing Then
                    ColDebut = Dela.Column
                Else: Exit For
                End If
            End If
            If Fin <> "" Then
                Set ALa = .Rows(7).Find(Fin, LookIn:=xlValues)
                If Not ALa Is Nothing Then
                    ColFin = ALa.Column
                Else: Exit For
                End If
            Else: ColFin = ColDebut
            End If
            If Debut <> "" Then
                .Cells(Ligne, ColDebut) = Atelier
                .Cells(Ligne, ColDebut).Interior.ColorIndex = couleur
            End If
            If ColDebut <> ColFin Then
                .Range(.Cells(Ligne, ColDebut), .Cells(Ligne, ColFin)).FillRight
                .Range(.Cells(Ligne, ColDebut), .Cells(Ligne, ColFin)).Interior.ColorIndex = couleur
            End If
        End With
    Next j
Next i

End Sub

[/cdoe]
Cliquez pour agrandir...

Merci beaucoup pour votre aide
:)
 
Vote positif 0 Vote négatif
R

Ralf94

XLDnaute Nouveau
vgendron à dit:
Hello
en fait ca fonctionne bien pour peu que le bouton "Go" soit placé dans la bonne feuille... "Avancement"
je m'a gourré :-D
j'ai donc remis le bouton Go dans la feuille Avancement, et corrigé le code pour que sa place n'ait finalement pas d'importance..

donc.
1) soit tu changes le bouton de place et tu laisses le code comme il est
2) soit tu laisses le bouton dans la feuille Planning Case et tu remplaces le code par celui ci:
VB: 
Sub planning()

NbPersonnes = Sheets("Avancement").Range("A" & Rows.Count).End(xlUp).Row - 3

For i = 1 To NbPersonnes
    Employé = Sheets("Avancement").Range("A" & i + 3)
    With Sheets("Planning case")
        Set ici = .Range("A8").Resize(NbPersonnes).Find(Employé, lookat:=xlWhole)
        If Not ici Is Nothing Then
            Ligne = ici.Row
        End If
    End With
    For j = 3 To 9 Step 2
        Atelier = Sheets("Avancement").Cells(1, j)
        couleur = Sheets("Avancement").Cells(1, j).Interior.ColorIndex
        Debut = Sheets("Avancement").Cells(i + 3, j)
        Fin = Sheets("Avancement").Cells(i + 3, j + 1)
        With Sheets("Planning case")
    
            If Debut <> "" Then
                Set Dela = .Rows(7).Find(Debut, LookIn:=xlValues)
                If Not Dela Is Nothing Then
                    ColDebut = Dela.Column
                Else: Exit For
                End If
            End If
            If Fin <> "" Then
                Set ALa = .Rows(7).Find(Fin, LookIn:=xlValues)
                If Not ALa Is Nothing Then
                    ColFin = ALa.Column
                Else: Exit For
                End If
            Else: ColFin = ColDebut
            End If
            If Debut <> "" Then
                .Cells(Ligne, ColDebut) = Atelier
                .Cells(Ligne, ColDebut).Interior.ColorIndex = couleur
            End If
            If ColDebut <> ColFin Then
                .Range(.Cells(Ligne, ColDebut), .Cells(Ligne, ColFin)).FillRight
                .Range(.Cells(Ligne, ColDebut), .Cells(Ligne, ColFin)).Interior.ColorIndex = couleur
            End If
        End With
    Next j
Next i

End Sub

[/cdoe]
Cliquez pour agrandir...

Je viens de voir quand je change une date et que je rappuies sur go sa ne retire pas la couleur et le numéro.
Par exemple dans la 1er ligne il y a le 27/11 en début et 30/11 en fin, ca va me remplir les 4 cases mais si je modifie et que je met du 27 au 28 ca ne va pas retirer les 2 cases en trop dans le planning.
 
Vote positif 0 Vote négatif
vgendron

vgendron

XLDnaute Barbatruc
Normal, la macro n'efface pas ce qui a été fait précédemment,
il faut ajouter une ligne en début de macro pour effacer
VB: 
NbPersonnes = Sheets("Avancement").Range("A" & Rows.Count).End(xlUp).Row - 3
Sheets("Planning case").Range("B8").Resize(NbPersonnes, 125).Clear
 
Vote positif 0 Vote négatif
vgendron

vgendron

XLDnaute Barbatruc
et comme tu vas me dire que tu souhaites garder le quadrillage..
mets ceci à la place
VB: 
NbPersonnes = Sheets("Avancement").Range("A" & Rows.Count).End(xlUp).Row - 3
With Sheets("Planning case").Range("B8").Resize(NbPersonnes, 125)
    .ClearContents
    With .Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
End With
 
Vote positif 0 Vote négatif
R

Ralf94

XLDnaute Nouveau
vgendron à dit:
et comme tu vas me dire que tu souhaites garder le quadrillage..
mets ceci à la place
VB: 
NbPersonnes = Sheets("Avancement").Range("A" & Rows.Count).End(xlUp).Row - 3
With Sheets("Planning case").Range("B8").Resize(NbPersonnes, 125)
    .ClearContents
    With .Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
End With
Cliquez pour agrandir...

LOL je n'ai que 4 mots à dire:
TU ES UNE MACHINE!!!
 
Vote positif 0 Vote négatif
R

Ralf94

XLDnaute Nouveau
Ralf94 à dit:
LOL je n'ai que 4 mots à dire:
TU ES UNE MACHINE!!!
Cliquez pour agrandir...

Bonjour,

Je reviens vers vous afin de savoir si vous pourriez m'expliquer quelques lignes afin que je puisse comprendre ce quelles veulent dire afin de pouvoir m'adapter au cas ou je dois modifier mon tableau?
par exemple la partie:

For j = 3 To 9 Step 2 <--
Set Dela = .Rows(7).Find(Debut, LookIn:=xlValues) <--

Merci pour votre aide
 
Vote positif 0 Vote négatif
vgendron

vgendron

XLDnaute Barbatruc
Hello
Revoici le code complet commenté
VB: 
Sub planning()


NbPersonnes = Sheets("Avancement").Range("A" & Rows.Count).End(xlUp).Row - 3 'dans la feuille avancement colonne A, récupère le numéro de la dernière ligne NON vide  et -3 (première ligne commence à 3) pour en déduire le nombre de personnes
With Sheets("Planning case").Range("B8").Resize(NbPersonnes, 125) 'dans la feuille Planning, on sélectionne le tablo qui commence en B8 - sur NbPersonnes lignes et 125 colonnes
    .ClearContents 'on efface le contenu
    With .Interior 'et on remet le remplissage de couleur à vide
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
End With

For i = 1 To NbPersonnes 'pour chaque personne
    Employé = Sheets("Avancement").Range("A" & i + 3) 'on récupère le nom de l'employé
    With Sheets("Planning case") 'on le cherche dans la colonne A du Planning (utile si les noms ne sont pas triés
        Set ici = .Range("A8").Resize(NbPersonnes).Find(Employé, lookat:=xlWhole)
        If Not ici Is Nothing Then
            Ligne = ici.Row 'on récupère son numéro de ligne
        End If
    End With
   
    For j = 3 To 9 Step 2 ' on est dans la feuille Avancement: on se déplace de la colonne 3 (C) à 9 (I) par pas de 2: C - E - G - I
        Atelier = Sheets("Avancement").Cells(1, j) 'on récupère le numéro de l'atelier sur la ligne 1
        couleur = Sheets("Avancement").Cells(1, j).Interior.ColorIndex 'on récupère la couleur
        Debut = Sheets("Avancement").Cells(i + 3, j) 'on récupère le début de l'activité
        Fin = Sheets("Avancement").Cells(i + 3, j + 1) 'on récupère la fin de l'activité
       
        With Sheets("Planning case") 'dans la feuille Planning
            If Debut <> "" Then 'si Debut n'est pas vide
                Set Dela = .Rows(7).Find(Debut, LookIn:=xlValues) 'on cherche la date de début sur la ligne 7
                If Not Dela Is Nothing Then
                    ColDebut = Dela.Column 'on récupère la colonne
                Else: Exit For
                End If
            End If
            If Fin <> "" Then 'si Fin n'est pas vide
                Set ALa = .Rows(7).Find(Fin, LookIn:=xlValues) 'on cherche la date de Fin sur la ligne 7
                If Not ALa Is Nothing Then
                    ColFin = ALa.Column 'on récupère la colonne
                Else: Exit For
                End If
            Else: ColFin = ColDebut 'si on avait une seule date, on met la fin = début
            End If
            If Debut <> "" Then
                .Cells(Ligne, ColDebut) = Atelier 'on place le numéro de l'atelier
                .Cells(Ligne, ColDebut).Interior.ColorIndex = couleur 'et sa couleur
            End If
            If ColDebut <> ColFin Then 'si on a une DUREE d'activité, on recopie sur toute la durée atelier et couleur
                .Range(.Cells(Ligne, ColDebut), .Cells(Ligne, ColFin)).FillRight
                .Range(.Cells(Ligne, ColDebut), .Cells(Ligne, ColFin)).Interior.ColorIndex = couleur
            End If
        End With
    Next j
Next i

End Sub
 
Vote positif 0 Vote négatif
R

Ralf94

XLDnaute Nouveau
vgendron à dit:
Hello
Revoici le code complet commenté
VB: 
Sub planning()


NbPersonnes = Sheets("Avancement").Range("A" & Rows.Count).End(xlUp).Row - 3 'dans la feuille avancement colonne A, récupère le numéro de la dernière ligne NON vide  et -3 (première ligne commence à 3) pour en déduire le nombre de personnes
With Sheets("Planning case").Range("B8").Resize(NbPersonnes, 125) 'dans la feuille Planning, on sélectionne le tablo qui commence en B8 - sur NbPersonnes lignes et 125 colonnes
    .ClearContents 'on efface le contenu
    With .Interior 'et on remet le remplissage de couleur à vide
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
End With

For i = 1 To NbPersonnes 'pour chaque personne
    Employé = Sheets("Avancement").Range("A" & i + 3) 'on récupère le nom de l'employé
    With Sheets("Planning case") 'on le cherche dans la colonne A du Planning (utile si les noms ne sont pas triés
        Set ici = .Range("A8").Resize(NbPersonnes).Find(Employé, lookat:=xlWhole)
        If Not ici Is Nothing Then
            Ligne = ici.Row 'on récupère son numéro de ligne
        End If
    End With
  
    For j = 3 To 9 Step 2 ' on est dans la feuille Avancement: on se déplace de la colonne 3 (C) à 9 (I) par pas de 2: C - E - G - I
        Atelier = Sheets("Avancement").Cells(1, j) 'on récupère le numéro de l'atelier sur la ligne 1
        couleur = Sheets("Avancement").Cells(1, j).Interior.ColorIndex 'on récupère la couleur
        Debut = Sheets("Avancement").Cells(i + 3, j) 'on récupère le début de l'activité
        Fin = Sheets("Avancement").Cells(i + 3, j + 1) 'on récupère la fin de l'activité
      
        With Sheets("Planning case") 'dans la feuille Planning
            If Debut <> "" Then 'si Debut n'est pas vide
                Set Dela = .Rows(7).Find(Debut, LookIn:=xlValues) 'on cherche la date de début sur la ligne 7
                If Not Dela Is Nothing Then
                    ColDebut = Dela.Column 'on récupère la colonne
                Else: Exit For
                End If
            End If
            If Fin <> "" Then 'si Fin n'est pas vide
                Set ALa = .Rows(7).Find(Fin, LookIn:=xlValues) 'on cherche la date de Fin sur la ligne 7
                If Not ALa Is Nothing Then
                    ColFin = ALa.Column 'on récupère la colonne
                Else: Exit For
                End If
            Else: ColFin = ColDebut 'si on avait une seule date, on met la fin = début
            End If
            If Debut <> "" Then
                .Cells(Ligne, ColDebut) = Atelier 'on place le numéro de l'atelier
                .Cells(Ligne, ColDebut).Interior.ColorIndex = couleur 'et sa couleur
            End If
            If ColDebut <> ColFin Then 'si on a une DUREE d'activité, on recopie sur toute la durée atelier et couleur
                .Range(.Cells(Ligne, ColDebut), .Cells(Ligne, ColFin)).FillRight
                .Range(.Cells(Ligne, ColDebut), .Cells(Ligne, ColFin)).Interior.ColorIndex = couleur
            End If
        End With
    Next j
Next i

End Sub
Cliquez pour agrandir...

et que veut dire le +3 dans :
Employé = Sheets("Avancement").Range("A" & i + 3) 'on récupère le nom de l'employé
 
Vote positif 0 Vote négatif

Discussions similaires

P
  • Question
Microsoft 365 Aide pour création fiche de paie en fonction de mon planning
Réponses
2
Affichages
251
Po-p0/59
P
V
  • Résolu(e)
XL 2019 Planning de réservation camping automatique
Réponses
5
Affichages
592
ValDorier
V
N
  • Question
Microsoft 365 Cherche a dupliquer des lignes en fonction d'un nombre indépendant sans macro
2
Réponses
16
Affichages
512
crocrocro
C
S
  • Résolu(e)
Microsoft 365 [RESOLU] Excel : Calcul de prix en fonction d'un type
Réponses
4
Affichages
217
JHA
J
A
  • Question
Microsoft 365 Fichier de statistique et roulement
Réponses
0
Affichages
433
Aurel’Byylieve
A
B
  • Question
XL 2016 Ramener une plage de données en fonction d'une cellule
Réponses
11
Affichages
366
JHA
J
D
  • Résolu(e)
Microsoft 365 Graphique avec plage de données glissante en partant d'une date
Réponses
5
Affichages
238
Dégé59
D
G
  • Question
XL 2016 définir un fichier source en fonction d'une cellule
Réponses
3
Affichages
320
scraper
S
N
  • Question
Microsoft 365 afficher/masquer des lignes en fonction de la valeur d'une cellule qui aura été renseignée par une autre feuille (via un copier/collé automatique)
Réponses
5
Affichages
444
Nel'
N
L
  • Résolu(e)
Microsoft 365 Aide : Colorer une cellule en fonction de sa valeur
Réponses
2
Affichages
322
Leo98
L

Membres actuellement en ligne

3 membres et 85 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
315 111
Messages
2 116 340
Membres
112 721
dernier inscrit
Ulricn