Bonjour,
J'ai besoin d'aide pour terminer la macro ci-après. Elle cherche à contrôler des éventuels chevauchements dans un planning,
Pour le moment la macro cherche à tester une seule colonne (1 jour = 1jour). Les peronnes plannifiées ne se suivent pas forcément dans le planning.
C'est pour cette raison que je cherche d'abord à répérer pour une personne les lignes où elle se trouve. Je prends la dernère plage horaire (de C à D) que je compare aux autres plages horaires (A et B) déjà plannifié pour la même journée.Si'il y a chevauchement je voudrais mettre une croix sur la tâche et mettre en rouge la plage horaire.
La macro buugg quelque part avant d'arriver à la comparaison.
Pouvez-vous svp m'aider ?
Sub Contôle_Chevauchement()
Application.ScreenUpdating = False
Dim Collaborateur As String
Dim Ligne As Long, Colonne As Long
Dim A As Variant, B As Variant, C As Variant, D As Variant
Dim Ligne_à_Contrôler As Long
Collaborateur = Range("E" & ActiveCell.Row).Value
' Je récupére la personne pour qui je souhaite faire le ctrl, à
'A terme, l'objectif est de faire une macro qui fait ce contrôle pour toutes les personnes (ligne par ligne) présentes dans le 'planning. Aussi je ne parcours qu'une seule colonne. A terme, il y aurait un boucle de la colonne 8 à 38.
Ligne = ActiveCell.Row
Colonne = ActiveCell.Column
With ActiveSheet.Range("E9:E" & ActiveCell.Row - 1)
Set C = .Find(Collaborateur, LookIn:=xlValues)
'l'idée c'est de comparer la plage horaire que l'on vient de mettre pour une personne
'n'est pas en conflit (chevauchement) avec une autre tâche de la même journée (donc dans la colonne)
If Not C Is Nothing Then
firstAddress = C.Address
Do
MsgBox C.Row
MsgBox "C= " & Format(Cells(ActiveCell.Row, 6).Value, "hh:mm") & _
" D= " & Format(Cells(ActiveCell.Row, 7).Value, "hh:mm")
MsgBox "A= " & Format(Cells(C.Row, 6).Value, "hh:mm") & _
" B= " & Format(Cells(C.Row, 7).Value, "hh:mm")
'Les bornes de la plage horaires que l'on vient de renseigner sont C et D. Les autres plages horaires à comparer avec celle
'que 'lon vient de renseigner ont pour borne A et B.Succesivement dans la comparaison, il y a souvent plusieurs A et B.
C = Cells(ActiveCell.Row, 6).Value
D = Cells(ActiveCell.Row, 7).Value
B = Cells(C.Row, 7).Value
A = Cells(C.Row, 6).Value
'= s'il existe une tâche dans la colonne et
'SI(OU(ET(C<=B;C>=A);ET(A<=D;A>=C));"Chevauchement";"Non chevauchement")
If Cells(C.Row, Colonne).Value <> "" And ((C <= B) And (C >= A)) Or ((A <= D) And (A >= C)) Then
Range(Cells(ActiveCell.Row, 6), Cells(ActiveCell.Row, 7)).Interior.Color = vbRed
Cells(ActiveCell.Row, Colonne).Borders(xlDiagonalDown).LineStyle = xlContinuous
Cells(ActiveCell.Row, Colonne).Borders(xlDiagonalUp).LineStyle = xlContinuous
Else
Range(Cells(ActiveCell.Row, 6), Cells(ActiveCell.Row, 7)).Interior.Color = RGB(255, 255, 255)
Cells(ActiveCell.Row, Colonne).Borders(xlDiagonalDown).LineStyle = xlNone
Cells(ActiveCell.Row, Colonne).Borders(xlDiagonalUp).LineStyle = xlNone
End If
Set C = .FindNext(C)
Loop While Not C Is Nothing And C.Address <> firstAddress
End If
End With
Application.ScreenUpdating = True
End Sub