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: 42
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

C
  • Question
XL 2021 VBA - créer une boucle de calcul pour remplir un tableau à partir de 2 autres sur une même feuille
Réponses
7
Affichages
299
clineM
C
C
  • Résolu(e)
XL 2021 Remplir données devis en vba avec descriptions/quantités/PUs alignés
2
Réponses
18
Affichages
437
Phil69970
Phil69970
younik
  • Question
XL 2016 Pb planning lors demande de congés sur 2 mois différents
2
Réponses
15
Affichages
508
ChTi160
ChTi160
S
  • Résolu(e)
Microsoft 365 Recherche de date en VBA
Réponses
6
Affichages
216
sylvanu
sylvanu
B
  • Question
Microsoft 365 remplir automatiquement une quantité de case en fonction d'un chiffre
Réponses
4
Affichages
394
binouse
B
chaelie2015
  • Résolu(e)
XL 2013 (RESOLU) Automatisation de la création de feuilles en fonction des données de la cellule U13 et une feuille type
Réponses
7
Affichages
243
chaelie2015
chaelie2015
S
  • Question
XL 2010 Saisir un nom en fonction du choix de deux menu déroulant.
Réponses
4
Affichages
265
Sirberthoult
S
misteryann
  • Question
XL 2016 (RESOLU) Planning de réservation perpétuel
Réponses
5
Affichages
428
misteryann
misteryann
S
  • Question
XL 2016 Problème de classement de prix croissants non désiré
Réponses
4
Affichages
378
chris
chris
T
  • Résolu(e)
Autres Fonction qui permets de récupérer plusieurs données
Réponses
2
Affichages
159
talbimassinissa
T

Membres actuellement en ligne

15 membres et 106 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
312 108
Messages
2 085 377
Membres
102 876
dernier inscrit
BouteilleMan