Sub remove_doublon_activite()
Dim rowsToBeDeleted, rowstobedeleted2() As Integer
Dim d As Date
Dim f As Date
Dim cellule As Range
Application.ScreenUpdating = False
blDimensioned = False
'on affiche tout
On Error Resume Next
ActiveSheet.ShowAllData
On Error GoTo 0
lastrow = Cells(Rows.Count, "D").End(xlUp).Row
'on filtre celles qui sont "en cours"
'ActiveSheet.Range("$A$1:$D" & Lastrow).AutoFilter Field:=1, Criteria1:="en cours"
'filtrer par noms
Columns("D
").Select
Range("D" & lastrow).Sort Key1:=Range("D1"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
' chercher la cellule statut
Cells.Find(What:="statut", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
'definir la position de début
statut = ActiveCell.Column
' chercher la cellule début de prise en charge
Cells.Find(What:="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 début
début = ActiveCell.Column
' chercher la cellule début de 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 fin effective
fin = ActiveCell.Column
'prendre la colonne D
[D
].Interior.ColorIndex = xlNone
'on fait un range avec la colonne D mais uniquement les cellules visibles
Set MyRg = ActiveSheet.Range("D2
" & 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("D" & CountInit & "
" & Count)
MyRg2.Select
asupprimer = False
'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 doit supprimer ce range
asupprimer = True
Exit For
End If
Next C2
'Si on a trouvé un doublon, on note les rows
If asupprimer = True Then
For i = CountInit To Count
If blDimensioned = True Then
ReDim Preserve rowsToBeDeleted(0 To UBound(rowsToBeDeleted) + 1) As Integer
Else
ReDim rowsToBeDeleted(0 To 0) As Integer
blDimensioned = True
End If
rowsToBeDeleted(UBound(rowsToBeDeleted)) = i
Debug.Print ("Row : " & i)
Next i
End If
End If
'Rows(c.Row - 1).Delete
' End If
'End If
NEXTC:
Next c
'suppression des lignes (on le fait en partant du bas sinon on change le numero des lignes suivantes et ca fout la merde !
If blDimensioned = True Then
For lngPosition = UBound(rowsToBeDeleted) To LBound(rowsToBeDeleted) Step -1
Rows(rowsToBeDeleted(lngPosition)).Select
Rows(rowsToBeDeleted(lngPosition)).Delete
Next lngPosition
End If
'définition à nouveau de la dernière ligne
lastrow3 = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
For i = lastrow3 To 2 Step -1 '(n'oublie pas le step -1 sinon il va essayer d'aller de lastrow3 a 2 en ajoutant 1...)
If Range("A" & i).Value = "en cours" Then Rows(i).Delete
Debug.Print ("Deleted row : " & i)
Next i
