XL 2010 Alimentation planning en fonction de données sur une feuille

[Joponta]

Bonjour,

Dans le fichier joint, je souhaiterais depuis la feuille de "données" alimenter le planning de la feuille AVRIL au niveau des colonnes DI de chaque date.
Si le matricule existe dejà sur la feuille AVRIL je souhaiterais qu'il se mette à jour en fonction des nouvelles données de la feuille "données"
Si la matricule existe pas sur la feuille AVRIL, ou si l'activité change je souhaiterais que la ligne se créer.

Merci pour votre aide.

 

[job75]

Bonjour Joponta,

Il faudra revoir votre fichier :

- en feuille AVRIL on a le nom DURAND et non pas CALLOIS, pourquoi ?

- d'où vient TECH en D3 ?

- rien ne permet de savoir si DM doit être placé en L3 ou en M3

- en feuille paramètres Pâques doit être le dimanche.

A+

 

[Joponta]

==>J'ai mis à jour le fichier. désolé pour l'erreur
==> Le motifs sont à placer dans la colonne DI qui correspond à la date.

 

[job75]

Voyez le fichier joint et la macro du bouton :

Sub MAJ_Plannings()
Dim P As Range, rc&, ligdeb&, lig&, w As Worksheet, mois As Byte, i&, j As Variant
Set P = Sheets("données").[A1].CurrentRegion
rc = P.Rows.Count
ligdeb = 3 '1ère ligne à renseigner, à adapter
lig = ligdeb
Application.ScreenUpdating = False
For Each w In Worksheets
    If IsDate("1/" & w.Name) Then
        With w.Rows(ligdeb & ":" & w.Rows.Count)
            .ClearContents 'RAZ
            .Interior.ColorIndex = xlNone 'RAZ
            .Borders.LineStyle = xlNone 'RAZ bordures
        End With
        mois = Month("1/" & w.Name)
        For i = 2 To rc
            If IsDate(P(i, 5)) Then
                If Month(P(i, 5)) = mois Then
                    w.Cells(lig, 1).Resize(, 4) = P(i, 1).Resize(, 4).Value
                    j = Application.Match(P(i, 5), w.Rows(1), 0)
                    If IsNumeric(j) Then w.Cells(lig, j) = P(i, 6)
                    lig = lig + 1
                End If
            End If
        Next i
        If lig > ligdeb Then w.Range("A" & ligdeb & ":I" & lig - 1).Borders.Weight = xlThin 'bordures
    End If
Next w
End Sub

 

[Joponta]

Merci pour votre retour qui fonctionne bien.
Néanmoins, une est créée même lorsque le matricule ne change pas d'activité.
Exemple du matricule 4545 dans le fichier joint sur les dates du 01/04 et 03/04 qui ne change pas d'activité sur ces deux dates.

 

[Joponta]

De plus j'ai un autre problème, lorsque je rempli les cellules des colonnes POS, celles-ci s'efface si j'exécute à nouveau la macro.

 

[job75]

Je ne peux rien faire de plus.

 

[job75]

De plus j'ai un autre problème, lorsque je rempli les cellules des colonnes POS, celles-ci s'efface si j'exécute à nouveau la macro.

Les colonnes POS ne doivent pas être renseignées manuellement.

Ajoutez une colonne dans la feuille "données" pour les alimenter de la même manière que les colonnes DI.

 

[Joponta]

Je ne peux pas car le but est de saisir manuellement la colonne POS en fonction des données de la colonne DI

 

[job75]

Alors il faudra renseigner toutes les colonnes POS chaque fois que vous cliquerez sur le bouton.

 

[Joponta]

Et pour le problème d'ajout de ligne pour un même matricule sans changement d'activité, il n'y a pas de solutions ?

 

[job75]

Ecoutez Joponta, à votre place je supprimerais tout bêtement la feuille "données".

Entrez au fur et à mesure vos données dans les feuilles des mois et n'en parlons plus.

 

[job75]

Bonjour Joponta, le forum,

Ce fichier (2) devrait vous satisfaire :

Sub MAJ_Plannings()
Dim ligdeb&, d As Object, tablo, w As Worksheet, nf$, col%, i&, dat As Variant, lig As Variant
ligdeb = 3
Set d = CreateObject("Scripting.Dictionary")
tablo = Sheets("données").[A1].CurrentRegion.Resize(, 6) 'matrice, plus rapide
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
For Each w In Worksheets
    nf = UCase(Trim(w.Name))
    If IsDate("1/" & nf) Then
        d.RemoveAll 'RAZ
        If w.FilterMode Then w.ShowAllData 'si la feuille est filtrée
        '---effacement des DI sans toucher aux POS---
        For col = 10 To 70 Step 2
            With w.Cells(ligdeb, col).Resize(w.Rows.Count - ligdeb + 1)
                .ClearContents
                .Interior.ColorIndex = xlNone
            End With
        Next col
        For i = 2 To UBound(tablo)
            dat = tablo(i, 5)
            If IsDate(dat) Then
                dat = CDate(dat)
                If Year(dat) = [année] And UCase(Format(dat, "mmmm")) = nf Then
                    ThisWorkbook.Names.Add "Critere", tablo(i, 1) & tablo(i, 4) 'nom défini
                    With w.Range("A1", w.UsedRange)
                        .Columns(1).Name = "Matricule" 'plages nommées
                        .Columns(4).Name = "Activite" 'plages nommées
                    End With
                    lig = [MATCH(Critere,Matricule&Activite,0)]
                    If IsError(lig) Then lig = Application.Max(ligdeb, w.Cells(w.Rows.Count, 1).End(xlUp).Row + 1)
                    d(lig) = "" 'mémorise les lignes traitées
                    w.Cells(lig, 1).Resize(, 4) = Application.Index(tablo, i, 0)
                    col = Application.Match(CLng(dat), w.Rows(1), 0)
                    Application.EnableEvents = True 'réactive les évènements pour appliquer la couleur
                    w.Cells(lig, col) = tablo(i, 6)
                    Application.EnableEvents = False 'désactive les évènements
                End If
            End If
        Next i
        '---suppression des lignes non traitées---
        For i = w.Cells(w.Rows.Count, 1).End(xlUp).Row To ligdeb Step -1
            If Not d.exists(i) Then w.Rows(i).Delete
        Next i
    End If
Next w
Application.EnableEvents = True 'réactive les évènements
MsgBox "Les plannings ont été mis à jour", vbInformation
End Sub

Edit : ajouté le test sur Year(dat).

A+

 

[Joponta]

Bonjour Joponta, le forum,

Ce fichier (2) devrait vous satisfaire :

Sub MAJ_Plannings()
Dim ligdeb&, d As Object, tablo, w As Worksheet, nf$, col%, i&, dat As Variant, lig As Variant
ligdeb = 3
Set d = CreateObject("Scripting.Dictionary")
tablo = Sheets("données").[A1].CurrentRegion.Resize(, 6) 'matrice, plus rapide
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
For Each w In Worksheets
    nf = UCase(Trim(w.Name))
    If IsDate("1/" & nf) Then
        d.RemoveAll 'RAZ
        If w.FilterMode Then w.ShowAllData 'si la feuille est filtrée
        '---effacement des DI sans toucher aux POS---
        For col = 10 To 70 Step 2
            With w.Cells(ligdeb, col).Resize(w.Rows.Count - ligdeb + 1)
                .ClearContents
                .Interior.ColorIndex = xlNone
            End With
        Next col
        For i = 2 To UBound(tablo)
            dat = tablo(i, 5)
            If IsDate(dat) Then
                dat = CDate(dat)
                If Year(dat) = [année] And UCase(Format(dat, "mmmm")) = nf Then
                    ThisWorkbook.Names.Add "Critere", tablo(i, 1) & tablo(i, 4) 'nom défini
                    With w.Range("A1", w.UsedRange)
                        .Columns(1).Name = "Matricule" 'plages nommées
                        .Columns(4).Name = "Activite" 'plages nommées
                    End With
                    lig = [MATCH(Critere,Matricule&Activite,0)]
                    If IsError(lig) Then lig = Application.Max(ligdeb, w.Cells(w.Rows.Count, 1).End(xlUp).Row + 1)
                    d(lig) = "" 'mémorise les lignes traitées
                    w.Cells(lig, 1).Resize(, 4) = Application.Index(tablo, i, 0)
                    col = Application.Match(CLng(dat), w.Rows(1), 0)
                    Application.EnableEvents = True 'réactive les évènements pour appliquer la couleur
                    w.Cells(lig, col) = tablo(i, 6)
                    Application.EnableEvents = False 'désactive les évènements
                End If
            End If
        Next i
        '---suppression des lignes non traitées---
        For i = w.Cells(w.Rows.Count, 1).End(xlUp).Row To ligdeb Step -1
            If Not d.exists(i) Then w.Rows(i).Delete
        Next i
    End If
Next w
Application.EnableEvents = True 'réactive les évènements
MsgBox "Les plannings ont été mis à jour", vbInformation
End Sub

Edit : ajouté le test sur Year(dat).

A+

Merci mais j'ai finalement une autre macro.