Supprimer opposées avec condition

[cheikh]

Bonjour à tous,
j'ai trouver un macro sur ce forum qui me permet de supprimer les valeurs opposées dans la colonne O.
Actuellement je veux ajouter une condition pour qu'avant de supprimer deux valeurs opposées de vérifier qu'ils ont les mêmes identifiants au niveau de la colonne K.

Sub SupprOppos()
Dim Zone As Range, c As Range, Oppos As Range
With Sheets("Test")
Set Zone = .Range("O8:O" & Range("O65536").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
On Error Resume Next
Zone.SpecialCells(xlCellTypeBlanks).EntireRow.Delete shift:=xlShiftUp
End Sub

 

[Paf]

Re : Supprimer opposées avec condition

Bonjour,

a priori,

For Each c In Zone
        Set Oppos = Zone.Find(What:=-c, After:=c, LookIn:=xlValues, Lookat:=xlWhole)
        If Not Oppos Is Nothing Then 
            If  c.offset(,-4) = Oppos.offset(,-4) then Oppos = "": c = ""
        End If
Next c

Non testé, faute de classeur joint.

A+

 

[cheikh]

Re : Supprimer opposées avec condition

Non testé, faute de classeur joint.
A+

Bonjour Paf,
j'ai tester la macro et ça marche bien.
Je me suis rendu compte aussi que parfois j'ai trois enregistrements ou plus avec le même identifiant et la somme des montants = 0.
j'ai essayé de gérer aussi ce cas avec cette ligne mais ça n'a pas l'air de marcher :

If c.Offset(, -4) = Oppos.Offset(, -4) Or Application.WorksheetFunction.SumIf(c.Offset(, -4), Oppos.Offset(, -4), Range("O:O")) Then Oppos = "": c = ""

Cf pièce-joint.

Merci d'avance.

 

[Paf]

Re : Supprimer opposées avec condition

re,

avec le classeur c'est un peu plus clair.

La recherche d'opposé s'effectuant sur les valeurs en colonne 0, il y a des chances que deux valeurs opposées n'appartiennent pas au même identifiant (colonne K)!

Si maintenant il y a plusieurs valeurs dont la somme est nulle, c'est carrément la loterie !

On pourrait partir sur une recherche par identifiant et sommer les valeurs trouvées puis affecter cette somme à chaque identifiant.
Il n'y a pas beaucoup d'exemples, mais j'imagine que la somme ne serait pas toujours nulle ?

un essai :

Sub LaMacroQuiRegroupe()
 Dim Zone, i As Long, MonDico
 With Sheets("Test")
 Zone = .Range("K8:O" & .Range("K65536").End(xlUp).Row)
 Set MonDico = CreateObject("Scripting.Dictionary")
 For i = LBound(Zone) To UBound(Zone)
     MonDico(Zone(i, 1)) = MonDico(Zone(i, 1)) + Zone(i, 5)
 Next

 For i = 8 To .Range("K65536").End(xlUp).Row
    .Cells(i, 15) = MonDico(CStr(.Cells(i, 11)))
 Next
 End With
End Sub

A+

 

[cheikh]

Re : Supprimer opposées avec condition

Merci encore. ça me va comme solution je l'ai juste adapté un peu en mettant la somme en colonne P et laisser les montants en colonne O puis supprimer les lignes où nous avons valeurs = 0 en colonne P avec un autre bloc whith.

Sub LaMacroQuiRegroupe()
 Dim Zone, i As Long, MonDico
 With Sheets("Test")
 Zone = .Range("K8:O" & .Range("K65536").End(xlUp).Row)
 Set MonDico = CreateObject("Scripting.Dictionary")
 For i = LBound(Zone) To UBound(Zone)
     MonDico(Zone(i, 1)) = MonDico(Zone(i, 1)) + Zone(i, 5)
 Next

 For i = 8 To .Range("K65536").End(xlUp).Row
    .Cells(i, 16) = MonDico(CStr(.Cells(i, 11)))
 Next
 End With
 On Error Resume Next
 With Range("P8:P" & [P65536].End(xlUp).Row)
    .Replace What:="0", Replacement:="", Lookat:=xlWhole
    .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End Sub

Si vous trouver y aura pas d'erreur ça me va et merci encore.

 

[Paf]

Re : Supprimer opposées avec condition

Re,

pour supprimer les lignes sans passer par la colonne P

Sub LaMacroQuiRegroupeV2()
 Dim Zone, i As Long, MonDico
 With Sheets("Test")
 Zone = .Range("K8:O" & .Range("K65536").End(xlUp).Row)
 Set MonDico = CreateObject("Scripting.Dictionary")
 For i = LBound(Zone) To UBound(Zone)
     MonDico(Zone(i, 1)) = MonDico(Zone(i, 1)) + Zone(i, 5)
 Next

 For i = .Range("K65536").End(xlUp).Row To 8 Step -1
    If MonDico(CStr(.Cells(i, 11))) = 0 Then .Rows(i).Delete
 Next
 End With
End Sub

A+

 

[cheikh]

Re : Supprimer opposées avec condition

re,
C'est parfait.
Merci bcp.

 

[cheikh]

Re : Supprimer opposées avec condition

Bonjour Paf,
je reviens vers vous car j'ai un petit souci qui persiste. La macro marche bien supprime les ligne = 0, mais en plus je qu'elle supprime les montants négligeables comme "0.00...." car il arrive souvent que j'ai des 0.0000005 ou même négligeable.
Merci d'avance

 

[cheikh]

Re : Supprimer opposées avec condition

re,
je pense qu'avec cette ligne de code c'est ok:

If MonDico(CStr(.Cells(i, 11))) < 0.01 And MonDico(CStr(.Cells(i, 11))) > -0.01 Then .Rows(i).Delete