Suppression des doublons dans l' autre sens

[Stephane]

Bonsoir le forum,

j' utilise cette macro pour supprimer les doublons, mais elle me supprime les valeurs les plus récentes et me garde la valeur la plus ancienne. Or, je voudrais garder la valeur la plus récente.

Sub Doublons()

Dim Plage As Range, Cel As Range
Dim Col As New Collection, ASupprimer As Range

Application.ScreenUpdating = False
Workbooks.Open Filename:='C:\\BASE.xls'
Sheets('Feuil1').Select
Cells.Select
With ActiveSheet
Set Plage = .Range('V2', .Range('V2').End(xlDown))
End With
For Each Cel In Plage
On Error Resume Next
Col.Add Cel, '_' & Cel
If Err.Number <> 0 Then
If ASupprimer Is Nothing Then Set ASupprimer = Cel Else _
Set ASupprimer = Union(ASupprimer, Cel)
End If
Next Cel
If Not ASupprimer Is Nothing Then ASupprimer.EntireRow.Delete
Range('A1').Select
ActiveWorkbook.Save
ActiveWorkbook.Close


End Sub

Merci de votre aide.

 

[Stephane]

Bonsoir,

N' ayant toujours pas trouvé de solution à mon problème, je tente une nouvelle fois la question : si dans la colonne V j' ai ,
1
2
3
3
3

la macro que j'utilise me supprime les lignes contenant les 2 derniers 3. Or je voudrais qu' elle me garde la dernière ligne contenant 3 et me supprime les 2 autres qui sont au-dessus.

Est-ce possible ?

Merci.

 

[Hervé]

Bonsoir stéphane

Une autre approche, en bouclant à 'l'envers' :

Sub Doublons()
Dim Col As New Collection
Dim i As Integer

Application.ScreenUpdating = False
Workbooks.Open Filename:='C:BASE.xls'
Sheets('Feuil1').Select

On Error GoTo supprime

With ActiveSheet
&nbsp; &nbsp; For i = .Range('v65536').End(xlUp).Row To 2 Step -1
&nbsp; &nbsp; &nbsp; &nbsp; Col.Add Range('v' & i), '_' & Range('v' & i)
&nbsp; &nbsp; Next i
End With

Application.ScreenUpdating = False

Exit Sub

supprime:
ActiveSheet.Rows(i).Delete
Resume Next

End Sub

J'ai pas compris comment s'initialisait le Asupprimer dans ton code ?

Salut

 

[Hellboy]

Bonsoir stéphane, Maître Hervé

Je n'aime tellement pas utiliser les 'on error goto'. :sick: (phobie que je dois traiter d'ailleurs). Une alternative que je suggère pour ceux qui souffre comme moi:

Sheets('Feuil1').Select
Cells(Cells(65536, 22).End(xlUp).Row, 22).Activate
Do
   With ActiveCell
        While .Value = .Offset(-1, 0) And .Row <> 2
              .Offset(-1, 0).Activate
              Selection.EntireRow.Delete
        Wend
       .Offset(-1, 0).Activate
   End With
Loop Until ActiveCell.Row <= 2

 

[Stephane]

Bonjour à tous,

Merci à Hervé et Hellboy pour leurs réponses. Je viens de tester les 2 codes :

Celui d' Hervé parfait.
Celui d' Hellboy, erreur au niveau de la ligne :
&nbs p;.Offset(-1, 0).Activate

Bonne journée. Stephane.

 

[Hellboy]

Bonjour Stephane, Hervé

Hmm! stephane, ceci '&nbs p;.' est un artéfact de caractère laissé parfois par ce site (je ne sais pas pourquoi, mais je n'en veux pas a qui ou quoi que ce soit) lorsque l'on copie collé le code. Il faut que tu enlève '&nbs p;.', il n'y a aucun rapport avec ce que j'ai proposé.

Bonne journée

 

[Stephane]

Bonjour Hellboy,

Etant pressé, j' avais juste fait un copié collé des 2 codes et essayé.
Je reviens donc sur mes conclusions hatives, pour dire que ton code fonctionne parfaitement. Maintenant je ne sais pas si sur un nombre important de lignes, il y a une différence de vitesse d' exécution entre ces 2 codes .
Donc attention à ceux qui feront comme moi un copié collé sans regarder le code : enlevez le \\'&nbs p;.\\' mais laissez tout de même le . devant Offset .

Bonne journée. Stephane.

 

[Hellboy]

Bonjour Stephane

Pour ma part, concernant la rapidité du code, je crois que celle d'Hervé est plus rapide, mais pas sur. Je base mon soucis sur le fait que j'ai 2 boucles. Mais ... c'est a tester. Si tu as le temps donne moi en des nouvelles, je suis curieux. Merci!