Supprimer lignes avec les Doublons

[yagami]

Bonjour


Je souhaiterai dans la mesure du possible avoir une macro excel qui permettrait de supprimer un nombre et son opposé qui se trouve dans une même colonne

Ex: si dans la cellule L5 est inscrit 1500 et que dans la cellule L9 est inscrit -1500, la macro devrait supprimer ces deux lignes.

Autre particularité: si est inscrit L5 =1500, L7=1500 et L9 =-1500, la macro devra supprimer L5 & L9.

La somme de la colonne L restera identique.


Merci d'avance pour votre aide.

 

[CBernardT]

Re : Supprimer lignes avec les Doublons

Bonsoir à tous,

Un essai de suppression des valeurs opposées en colonne A.

Sub SupprValOppos()
Dim Derlig As Integer, i As Integer, j As Integer

With Sheets("Feuil1")
Derlig = .Range("A65536").End(xlUp).Row
For i = 1 To Derlig - 1
If .Cells(i, 1) <> "" Then
For j = i + 1 To Derlig
If .Cells(j, 1) = -Cells(i, 1) Then
.Cells(j, 1) = ""
.Cells(i, 1) = ""
Exit For
End If
Next j
End If
Next i
End With
End Sub

 

[Softmama]

Re : Supprimer lignes avec les Doublons

Bonsoir Yagami et CBernardT,


Dans le cas où ta colonne A de données serait assez conséquente, je te joins une variante du code de CBernardT qui rendra l'exécution plus rapide :

Sub SupprValOppos2()
Dim Zone As Range, c As Range, Oppos As Range
With Sheets("Feuil1")
Set Zone = .Range("A1:A" & Range("A65536").End(xlUp).Row )
    For Each c In Zone
        Set Oppos = Zone.Find(What:=-c, After:=c, LookIn:=xlValues, Lookat:=xlWhole)
        If Not Oppos Is Nothing Then Oppos = "": c=""
    Next c
End With
Zone.SpecialCells(xlCellTypeBlanks).Delete shift:=xlShiftUp 'Enlever cette ligne si tu ne veux pas détruire les cellules effacées
End Sub

 

[yagami]

Re : Supprimer lignes avec les Doublons

Bonjour CbernardT et Softmama.

Merci pour vos codes, les deux marchent parfaitement.

Néanmoins serait il possible d'utiliser ce code sur toute feuille désirée et non pas uniquement la feuille1?

Cordialement

 

[Softmama]

Re : Supprimer lignes avec les Doublons

Oui, il suffit de modifier dans le code :

With Sheets("Feuil1")

par

 With ActiveSheet

Lorsque tu lanceras la macro, elle appliquera les modifs sur la feuille activée.

 

[CBernardT]

Re : Supprimer lignes avec les Doublons

Bonjour yagami, Softmama et le forum,


En cas d'une quantité importante de valeurs à traiter, il faut passer en version tableau dynamique. Les explications sont dans le code :

Sub SupprValOppos()
Dim Derlig As Integer, i As Integer, j As Integer, Tablo, Start

Application.ScreenUpdating = False
Start = Timer
' Travail dans la feuille "Feuil1"
With Sheets("Feuil1")
' Dernière cellule de la colonne A avec un objet
Derlig = .Range("A65536").End(xlUp).Row
' Mise en tableau dynamique de la plage à traiter
Tablo = .Range("A1:A" & Derlig)
' Boucle sur toutes les valeurs de la plage
For i = 1 To Derlig - 1
If Tablo(i, 1) <> "" Then ' Saute les valeurs vides
For j = i + 1 To Derlig ' Boucle sur les valeurs après la valeur en traitement
If Tablo(j, 1) = -Tablo(i, 1) Then ' Recherche de la première valeur opposée
Tablo(j, 1) = "" ' Vidage de la première valeur opposée trouvée
Tablo(i, 1) = "" ' Vidage de la valeur de la plage en traitement
Exit For ' Sortie de la boucle
End If
Next j
End If
Next i ' Répétition du traitement sur les autres valeurs existantes
' Affichage des valeurs restantes
.Range("A1").Resize(UBound(Tablo, 1), UBound(Tablo, 2)) = Tablo
End With
'Message du temps de traitement
MsgBox Application.RoundUp(Timer - Start, 0) & " secondes"
End Sub

Pour changer de nom de feuille, dans la ligne With Sheets("Feuil1"), changer Feuil1 par le nom de la feuille contenant les valeurs.

J'ai ajouté un Timer pour connaître le temps de traitement.

 

[Softmama]

Re : Supprimer lignes avec les Doublons

Re,

Oui, le traitement par tableaux, moins aisés à manipuler, assure un gain de temps très significatif 🙂

 

[yagami]

Re : Supprimer lignes avec les Doublons

Merci beaucoup


cordialement