Modification code VBA : incrémentation en fonction de la date et du nom

Le 31/03/2023 à 19:06

Bonjour à tous !

Je suis débutant en macro VBA, j'apprends en autodidacte mais étant étudiante et en apprentissage j'ai pas le temps de pratiquer en continu...

J'ai ajouté une colonne "responsable" sur mon outils : sur l'onglet caldendrier final entre la colonne Pôle et Poste, idem sur l'onglet 2023.

Ainsi, j'ai essayé de modifier la macro initiale (première macro) :

Private Sub Worksheet_Change(ByVal Target As Range)
    If Application.Intersect(Target, Range("B4")) Is Nothing Then Exit Sub
        'Si Date du jour ne change pas on quitte la procedure
    Dim Col_Jour1, L_Agent, J_Agent As Integer  'Colonne jour 1 / Ligne Agent / Jour Agent
    Dim L_Agent_Inconnu As Long     'Ligne pour l'agent non connu
    Dim C_Agent As Range            'Cellule Agent
    Dim Jour1Mois As Date           '1er jour du mois
    Dim C_Periode As String         'Cellule AM ou PM

    Range("J7:AN132").ClearContents 'vider les données
    Jour1Mois = DateValue("1 " & Range("B3").Value & " " & Range("B2").Value)

With Sheets("2023")
    If .Range("F2").Value <> Range("B2").Value Then
        MsgBox ("La feuille " & Range("B2").Value & " n'existe pas")
        Exit Sub
    End If

    Col_Jour1 = 7 + Jour1Mois - .Range("G5").Value

    For L_Agent = 6 To .Range("F" & Rows.Count).End(xlUp).Row     'Boucle sur Agent
        For J_Agent = Col_Jour1 To Col_Jour1 + 31                 'Boucle sur Jour /mois en cours
            If .Cells(L_Agent, J_Agent).Value <> "" Then

IncriptionInconnu:  'Point retour pour les jour de l'agent non connu

                Set C_Agent = Columns(7).Find(.Cells(L_Agent, 6).Value, LookIn:=xlValues)
                C_Periode = .Cells(L_Agent, 5).Value    'localisation de la plage période dans la feuille "2023"

                'C_Agent = la cellule Agent dans Calendrier final correspondant a la ligne "i" du 2023

                If Not C_Agent Is Nothing Then  'si l'agent est trouvé

                    If C_Periode = "AM" Then Cells(C_Agent.Row, 10 + J_Agent - Col_Jour1).Value = .Cells(L_Agent, J_Agent).Value
                    If C_Periode = "PM" Then Cells(C_Agent.Row + 1, 10 + J_Agent - Col_Jour1).Value = .Cells(L_Agent, J_Agent).Value

                Else    'sinon on le liste dans le calendrier
                    L_Agent_Inconnu = Range("G" & Rows.Count).End(xlUp).Row + 3         'Agent non inscrit sur calendrier final -> A creer sous le tableau
                    Range("A" & L_Agent_Inconnu).Value = .Range("A" & L_Agent).Value    'Etape
                    Range("B" & L_Agent_Inconnu).Value = .Range("B" & L_Agent).Value    'Pole
                    Range("C" & L_Agent_Inconnu).Value = .Range("C" & L_Agent).Value    'Poste
                    Range("F" & L_Agent_Inconnu).Value = .Range("D" & L_Agent).Value    'Bureau
                    Range("G" & L_Agent_Inconnu).Value = .Cells(L_Agent, 6).Value       'Agent
                    Range("H" & L_Agent_Inconnu).Value = .Cells(L_Agent, 5).Value       'Periode
                    'On passe sur la ligne PM
                    Range("A" & L_Agent_Inconnu + 1).Value = .Range("A" & L_Agent + 1).Value
                    Range("B" & L_Agent_Inconnu + 1).Value = .Range("B" & L_Agent + 1).Value
                    Range("C" & L_Agent_Inconnu + 1).Value = .Range("C" & L_Agent + 1).Value
                    Range("F" & L_Agent_Inconnu + 1).Value = .Range("D" & L_Agent + 1).Value
                    Range("G" & L_Agent_Inconnu + 1).Value = .Cells(L_Agent + 1, 6).Value
                    Range("H" & L_Agent_Inconnu + 1).Value = .Cells(L_Agent + 1, 5).Value
                    GoTo IncriptionInconnu  'L'agent est en liste on retrouner plus  haut dans la procedure pour identifier les jours J_Agent
                End If
            End If
        Next J_Agent
    Next L_Agent
End With
End Sub

Avec la suivante :

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    If Application.Intersect(Target, Range("B4")) Is Nothing Then Exit Sub
        'Si Date du jour ne change pas on quitte la procedure
    Dim Col_Jour1, L_Agent, J_Agent As Integer  'Colonne jour 1 / Ligne Agent / Jour Agent
    Dim L_Agent_Inconnu As Long     'Ligne pour l'agent non connu
    Dim C_Agent As Range            'Cellule Agent
    Dim Jour1Mois As Date           '1er jour du mois
    Dim C_Periode As String         'Cellule AM ou PM

    Range("K7:AO132").ClearContents 'vider les données
    Jour1Mois = DateValue("1 " & Range("B3").Value & " " & Range("B2").Value) 'B3 = mois B2 = année

With Sheets("2023") 'avec l'onglet "2023"
    If .Range("G2").Value <> Range("B2").Value Then
        MsgBox ("La feuille " & Range("B2").Value & " n'existe pas")
        Exit Sub
    End If

    Col_Jour1 = 7 + Jour1Mois - .Range("H5").Value

    For L_Agent = 6 To .Range("G" & Rows.Count).End(xlUp).Row     'Boucle sur Agent
        For J_Agent = Col_Jour1 To Col_Jour1 + 31                 'Boucle sur Jour /mois en cours
            If .Cells(L_Agent, J_Agent).Value <> "" Then

IncriptionInconnu:  'Point retour pour les jour de l'agent non connu

                Set C_Agent = Columns(8).Find(.Cells(L_Agent, 6).Value, LookIn:=xlValues)
                C_Periode = .Cells(L_Agent, 6).Value    'localisation de la plage période dans la feuille "2023"

                'C_Agent = la cellule Agent dans Calendrier final correspondant a la ligne "i" du 2023

                If Not C_Agent Is Nothing Then  'si l'agent est trouvé

                    If C_Periode = "AM" Then Cells(C_Agent.Row, 11 + J_Agent - Col_Jour1).Value = .Cells(L_Agent, J_Agent).Value
                    If C_Periode = "PM" Then Cells(C_Agent.Row + 1, 11 + J_Agent - Col_Jour1).Value = .Cells(L_Agent, J_Agent).Value

                Else    'sinon on le liste dans le calendrier
                    L_Agent_Inconnu = Range("G" & Rows.Count).End(xlUp).Row + 3         'Agent non inscrit sur calendrier final -> A creer sous le tableau
                    Range("A" & L_Agent_Inconnu).Value = .Range("A" & L_Agent).Value    'Etage
                    Range("B" & L_Agent_Inconnu).Value = .Range("B" & L_Agent).Value    'Pole
                    Range("C" & L_Agent_Inconnu).Value = .Range("C" & L_Agent).Value    'Responsable
                    Range("D" & L_Agent_Inconnu).Value = .Range("D" & L_Agent).Value    'Poste
                    Range("E" & L_Agent_Inconnu).Value = .Range("F" & L_Agent).Value    'Bureau
                    Range("G" & L_Agent_Inconnu).Value = .Cells(L_Agent, 8).Value       'Agent
                    Range("F" & L_Agent_Inconnu).Value = .Cells(L_Agent, 9).Value       'Periode

                    'On passe sur la ligne PM

                    Range("A" & L_Agent_Inconnu + 1).Value = .Range("A" & L_Agent + 1).Value 'Etage
                    Range("B" & L_Agent_Inconnu + 1).Value = .Range("B" & L_Agent + 1).Value    'Pôle
                    Range("C" & L_Agent_Inconnu + 1).Value = .Range("C" & L_Agent + 1).Value    'Responsable
                    Range("D" & L_Agent_Inconnu + 1).Value = .Range("D" & L_Agent + 1).Value       'Poste
                    Range("E" & L_Agent_Inconnu + 1).Value = .Range("F" & L_Agent + 1).Value    'Bureau
                    Range("G" & L_Agent_Inconnu + 1).Value = .Cells(L_Agent + 1, 8).Value   'Agent
                    Range("F" & L_Agent_Inconnu + 1).Value = .Cells(L_Agent + 1, 9).Value   'Période
                    GoTo IncriptionInconnu  'L'agent est en liste on retrouner plus  haut dans la procedure pour identifier les jours J_Agent
                End If
            End If
        Next J_Agent
    Next L_Agent
End With
End Sub

Je n'arrive pas à comprendre ce qui cloche... Mon objectif est qu'en indiquant une date sur l'onglet calendrier en cellule $B$4, ma plage de donnée s'incrémente en fonction de la période AM/PM et des agents indiqués en colonne agent (et de la date aussi).

Quelqu'un peut-il m'aider à corriger ce code ? Pour plus de visu, le tableau anonymisé en PJ.

Je vous remercie par avance et vous souhaite une excellente soirée !

18planning.xlsm (294.50 Ko)
Le 31/03/2023 à 19:33

bonjour,

Set C_Agent = Columns(8).Find(.Cells(L_Agent, 7).Value, LookIn:=xlValues) ???

Le 01/04/2023 à 10:24

BsAlv bonjour

Set C_Agent = Columns(8).Find(.Cells(L_Agent, 7).Value, LookIn:=xlValues) ???

Je ne comprends pas vraiment le sens de tes "??" mais j'ai regardé un peu, ça correspond à la ligne agent en 6 c'est ça ? En modifiant par 7, ça m'insère des données d'absence dans ma plage date

Rechercher des sujets similaires à "modification code vba incrementation fonction date nom"