Sub analyse_réel_jeunes_game_mesures()
Application.ScreenUpdating = False
Sheets("GAME MESURES").Activate
Dim d As Date
Dim f As Date
Dim fp As Date
Dim cellule As Range
Dim cellu As Range
'oui je te fais chier avec mon Lastrow
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
' chercher la cellule statut
Cells.Find(What:="Statut de la Prise en Charge", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
'definir la position de statut
statut = ActiveCell.Column
' chercher la cellule identifiant
Cells.Find(What:="Identifiant", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
'definir la position de statut
identifiant = ActiveCell.Column
' chercher la cellule date de début de la prise en charge
Cells.Find(What:="Date Début de Prise en Charge", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
'definir la position de la date de début
début = ActiveCell.Column
' chercher la cellule fin prévue
Cells.Find(What:="Date Fin Prévue", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
'definir la position de statut
fin_prévue = ActiveCell.Column
' chercher la cellule fin effective
Cells.Find(What:="Date Fin Effective", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
'definir la position de statut
fin_effective = ActiveCell.Column
Columns.identifiant.Select
Range(identifiant & lastrow).Sort Key1:=Range(Cells(ActiveCell.Row, identifiant)), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Set myrg = ActiveSheet.Range(identifiant & lastrow).Rows.SpecialCells(xlCellTypeVisible)
myrg.Select
doublonDetected = False
lastIdentifiant = 0
For Each c In myrg
c.Select
'lastIdentifiant permet de sauter completement un paquet de doublons
If lastIdentifiant = c.Value Then GoTo NEXTC
lastIdentifiant = c.Value
countinit = c.Row
Count = c.Row
'On cherche a savoir si on a un doublon et jusqu'a ou on a le doublon
Do While c.Value = Cells(Count + 1, c.Column):
Count = Count + 1
Loop
'Si on a un doublon alors la condition suivante est remplie
If Count > c.Row Then 'on a un doublon
Set MyRg2 = Range(identifiant & countinit & identifiant & Count)
MyRg2.Select
'On cherche si on a la valeur "en cours" parmis ces doublons
For Each C2 In MyRg2
If Cells(C2.Row, statut).Value = "en cours" Then 'alors on sait que cette ligne n'est pas clôturée
en_cours = True
Exit For
End If
Next C2
'Si on a trouvé un doublon, on note les rows
If en_cours = True Then
Set MyRg5 = Range(Cells(countinit, début), Cells(Count, début))
MyRg5.Select
d = Application.WorksheetFunction.Min(MyRg5)
datestart = d
'définition de la plus grande date de fin éffective
Set myrg6 = Range(Cells(countinit, fin), Cells(Count, fin))
myrg6.Select
f = Application.WorksheetFunction.Max(myrg6)
dateend = f