supprimer les lignes dont 2 valeurs sont de signes opposés à certaines conditions

[WIsh_]

Bonjour à tous,

Voir mon fichier test ci-joint.

Je cherche une macro pour :
- supprimer les lignes qui ont la valeur 903 ou 103 en colonne D ;
- supprimer les lignes 101 et 102 qui ont la même valeur en colonne U, en colonne A et dont la somme des valeurs en colonne N est égale à 0.

et je cale.

Merci d'avance pour votre aide !

 

[WIsh_]

Bon comme début:

Sub suppressionligne()
For i = Cells(1, 4).CurrentRegion.Rows.Count To 1 Step -1
If Cells(i, 4).Value = "103" Then Cells(i, 1).EntireRow.Delete
Next
End Sub

 

[WIsh_]

avec la condition collonne D = 903 en plus

Sub suppressionligne()
For i = Cells(1, 4).CurrentRegion.Rows.Count To 1 Step -1
If Cells(i, 4).Value = "103" Or Cells(i, 4) = "903" Then Cells(i, 4).EntireRow.Delete
Next
End Sub

 

[WIsh_]

RE bonsoir,

J'ai donc réussi à résoudre la 1ère partie de mon problème.

Concernant la seconde partie je ne m'en sors pas.

Je voudrais supprimers les lignes dont la somme des valeurs présentes dans la colonne N sont égales à 0. Ces lignes doivent aussi avoir la même valeur en colonne A et en colonne U.

Ces lignes s'annulent et viennent donc polluer mon fichier sur lequel je dois ensuite appliquer des formules qui ne focntionnent pas à cause de celles-ci.

J'aimerais par exemple supprimer les lignes surlignéeen jaune dans mon fichier ci-joint.

aidez-moi svp
merci d'avance

 

[job75]

Bonsoir Wish_,

Il n'y a pas que les lignes 6 et 9 qui répondent aux critères.

Pourquoi ne pas supprimer aussi les lignes 4, 5, 7, 8, 10, 12, 13, 14, 15, 16, 17, 18 ??

Bonne nuit.

 

[WIsh_]

Bonsoir Wish_,

Il n'y a pas que les lignes 6 et 9 qui répondent aux critères.

Pourquoi ne pas supprimer aussi les lignes 4, 5, 7, 8, 10, 12, 13, 14, 15, 16, 17, 18 ??

Bonne nuit.

En effet, les lignes 6 et 9 c'était un exemple pour illustrer vu que je n'avais pas de réponse.

Le but est bien de supprimer toutes les lignes qui répondent aux conditions...

Bonne nuit aussi Job

 

[WIsh_]

Bonjour à tous,

Toujours pas trouvé la solution...

Quelqu'un qui se débrouille plus que bien en macro ?

Merci d'avance,
Wish

 

[WIsh_]

Re bonjour,

Je crois qu'on peut s'inspirer de code en modifiant/ajoutant des conditions.
Ce code vise à supprimer les lignes qui ont une valeur de signe opposé.
Je ne maitrise pas assez pour l'adapter...

Sub supp_lignes()
'on déclare les variables
Dim Valeur_Cherchee As Long
Dim PlageDeRecherche As Range, Trouve As Range

For I = 2 To Range("A65536").End(xlUp).Row 'on lance une boucle qui va tester les lignes 2 à la dernière renseignée(colonne A)
If Cells(I, 1) = "" Then Exit For 'Si cellule col A vide on sort de la boucle

If Cells(I, 2).Value = "op" And InStr(Cells(I, 3).Value, "-") And I >= 2 Then 'on vérifié qu'en B on a "OP" et le signe "-" en C
Valeur_Cherchee = Replace(Cells(I, 3).Value, "-", "") 'on récupère la valeur absolue du chiffre
Set PlageDeRecherche = Cells(I, 3).EntireColumn 'on déclare la plage de recherche - ici colonne C
Set Trouve = PlageDeRecherche.Cells.Find(what:=Valeur_Cherchee, LookAt:=xlWhole) 'on lance la recherche
If Trouve Is Nothing Then 'si on trouve rien on ne fait rien
Else 'sinon si on trouve on fait :
If I < Trouve.Row And Trouve.Row <> I Then 'si I inf à la ligne trouvée
Cells(Trouve.Row, 3).EntireRow.Delete 'on sup la ligne trouvée
Cells(I, 3).EntireRow.Delete 'on sup la ligne I
I = I - 1 'I = I-1 pour ne pas oublier de ligne à cause de la sup
ElseIf I > Trouve.Row And Trouve.Row <> I Then
Cells(I, 3).EntireRow.Delete
Cells(Trouve.Row, 3).EntireRow.Delete
I = I - 1
End If
End If
End If
Next I
End Sub

 

[job75]

Bonjour Wlsh_, le forum,

Voyez le fichier joint et cette macro dans le code de la feuille "Résultat" :

Private Sub Worksheet_Activate()
Dim ncol%, tablo, d As Object, i&, n&, j%
With Sheets("Source").[A1].CurrentRegion
    ncol = .Columns.Count
    If ncol < 21 Then ncol = 21
    tablo = .Resize(, ncol) 'matrice, plus rapide
End With
'---liste des éléments concaténés---
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(tablo)
    If IsNumeric(CStr(tablo(i, 14))) Then d(tablo(i, 1) & Chr(1) & -tablo(i, 14) & Chr(1) & tablo(i, 21)) = ""
Next i
'---tableau des résultats---
For i = 2 To UBound(tablo)
    If Not d.exists(tablo(i, 1) & Chr(1) & tablo(i, 14) & Chr(1) & tablo(i, 21)) Then
        n = n + 1
        For j = 1 To ncol
            tablo(n, j) = tablo(i, j)
        Next j
    End If
Next i
'---restitution---
If FilterMode Then ShowAllData 'si la feuille est filtrée
With [A2] '1ère cellule de restitution
    If n Then .Resize(n, ncol) = tablo
    .Offset(n).Resize(Rows.Count - n - .Row + 1, ncol).ClearContents 'RAZ en dessous
End With
With UsedRange: End With 'actualise la barre de défilement verticale
End Sub

Elle s'exécute quand on active la feuille et elle est très rapide grâce au Dictionary.

Bonne journée.

 

[WIsh_]

Bonjour Job,

Merci déjà.

Qu'entendez-vous par activer la feuille résultat?
Merci

 

[job75]

Activer une feuille c'est l'afficher en cliquant sur son onglet.

Si l'on veut colorier les lignes supprimées de la feuille "Source" on peut utiliser une mise en forme conditionnelle (MFC).

Pour repérer les lignes conservées la macro doit être un peu modifiée, voyez ce fichier (2) :

Private Sub Worksheet_Activate()
Dim ncol%, tablo, d As Object, i&, resu(), x$, n&, j%
With Sheets("Source").[A1].CurrentRegion
    ncol = .Columns.Count
    If ncol < 21 Then ncol = 21
    tablo = .Resize(, ncol) 'matrice, plus rapide
End With
'---liste des éléments concaténés---
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(tablo)
    If IsNumeric(CStr(tablo(i, 14))) Then d(tablo(i, 1) & Chr(1) & -tablo(i, 14) & Chr(1) & tablo(i, 21)) = ""
Next i
'---tableau des résultats---
ReDim resu(1 To UBound(tablo), 1 To ncol + 1) 'une colonne de plus
For i = 2 To UBound(tablo)
    x = tablo(i, 1) & Chr(1) & tablo(i, 14) & Chr(1) & tablo(i, 21)
    If Not d.exists(x) Then
        n = n + 1
        resu(n, 1) = i 'récupère le numéro de ligne
        For j = 1 To ncol
            resu(n, j + 1) = tablo(i, j)
        Next j
    End If
Next i
'---restitution---
If FilterMode Then ShowAllData 'si la feuille est filtrée
With [A2] '1ère cellule de restitution
    If n Then .Resize(n, ncol + 1) = resu
    .Offset(n).Resize(Rows.Count - n - .Row + 1, ncol + 1).ClearContents 'RAZ en dessous
End With
With UsedRange: End With 'actualise la barre de défilement verticale
End Sub

Bien entendu le calcul de la MFC avec NB.SI prend un certain temps.

 

[WIsh_]

Re Job75,

Peut-on ajouter le code pour supprimer les lignes 103 et 903 avant d'exécuter ta macro ?

Sub suppressionligne()
For i = Cells(1, 4).CurrentRegion.Rows.Count To 1 Step -1
If Cells(i, 4).Value = "103" Or Cells(i, 4) = "903" Then Cells(i, 4).EntireRow.Delete
Next
End Sub

et également créer la feuille résultat avec les intitulés de colonnes avant de procéder ?

ça fonctionne super en tout cas

Merci d'avance,
WIsh

 

[Maxime 59]

Bonjour à tous,

Toujours pas trouvé la solution...

Quelqu'un qui se débrouille plus que bien en macro ?

Merci d'avance,
Wish

Bonjour WIsh,

Tu peux utiliser cette macro..., je l'ai testée et ça fonctionne..., il te suffit de la coller dans un module...

Sub suppr_doublon()
ActiveWorkbook.Sheets("source").Select
ActiveSheet.Range("N1").Select
lig_fin = Selection.End(xlDown).Row
'i = lig_fin
If lig_fin > 1 Then
For i = lig_fin To 2 Step -1
ref1 = Cells(i, 1).Value
ref2 = Cells(i, 21).Value
Valeur = Cells(i, 14).Value

For j = i - 1 To 2 Step -1
If Cells(j, 1) = ref1 And Cells(j, 21) = ref2 And Cells(j, 14) = Valeur * (-1) Then
Rows(i & ":" & i).Select
Selection.Delete shift:=xlUp
Rows(j & ":" & j).Select
Selection.Delete shift:=xlUp
i = i - 1
If i < 2 Then
GoTo suite
End If
GoTo suitei
End If
Next j
suitei:
Next i
End If
suite:
End Sub

J'espère que ça répondra à ta problématique.

 

[job75]

Si l'on veut aller vite il ne faut surtout pas travailler sur les cellules mais sur des tableaux VBA comme je l'ai montré.

Donc pour ajouter les critères "103" et "903" de la colonne D c'est bien simple, voyez ce fichier (3) avec :

Private Sub Worksheet_Activate()
Dim ncol%, tablo, d As Object, i&, resu(), x$, n&, j%
With Sheets("Source").[A1].CurrentRegion
    ncol = .Columns.Count
    If ncol < 21 Then ncol = 21
    tablo = .Resize(, ncol) 'matrice, plus rapide
End With
'---liste des éléments concaténés---
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(tablo)
    If IsNumeric(CStr(tablo(i, 14))) Then d(tablo(i, 1) & Chr(1) & -tablo(i, 14) & Chr(1) & tablo(i, 21)) = ""
Next i
'---tableau des résultats---
ReDim resu(1 To UBound(tablo), 1 To ncol + 1) 'une colonne de plus
For i = 2 To UBound(tablo)
    x = tablo(i, 1) & Chr(1) & tablo(i, 14) & Chr(1) & tablo(i, 21)
    If CStr(tablo(i, 4)) <> "103" And CStr(tablo(i, 4)) <> "903" And Not d.exists(x) Then
        n = n + 1
        resu(n, 1) = i 'récupère le numéro de ligne
        For j = 1 To ncol
            resu(n, j + 1) = tablo(i, j)
        Next j
    End If
Next i
'---restitution---
If FilterMode Then ShowAllData 'si la feuille est filtrée
With [A2] '1ère cellule de restitution
    If n Then .Resize(n, ncol + 1) = resu
    .Offset(n).Resize(Rows.Count - n - .Row + 1, ncol + 1).ClearContents 'RAZ en dessous
End With
With UsedRange: End With 'actualise la barre de défilement verticale
End Sub

PS : pour les titres de la feuille "Résultat" il suffit de les créer manuellement une fois pour toutes, par copier-coller.

 

[WIsh_]

Merci.

Il me semble que les lignes avec les données "103" ou "903" sont déjà supprimées avec le code précédent.
Je ne souhaite finalement plus supprimer ces lignes :-/

désolé et merci d'avance