Supprimer des lignes avec les valeurs qui se nettent

Le 18/03/2021 à 18:19

Bonjour

j'ai une feuille excel avec des centaines de lignes. il ya plusieurs lignes dans la feuille avec des valeurs qui s'annulent (collone C). j'aimerais supprimer ou cacher ces lignes avec comme conditions que les données aient été enrégistré le même mois (colonne D) .

Je met un exemple du fichier en pièce jointe.

Veuillez s'ils vous plaît bien m'expliquer la méthode utiliser pour que je puisse le reproduire dans d'autres feuilles.

Merci d'avance

8sup-lines.xlsx (123.57 Ko)
Le 18/03/2021 à 21:48

Bonsoir,

lors de suppression de lignes en "série" sur une feuille Excel, il faut commencer par la cellule du bas et remonter vers le haut.

Il faut donc trouver cette cellule, ici en colonne C :

derniereLigne = Cells(Rows.Count, 3).End(xlUp).Row

Ensuite on met en place une boucle avec un décrément de -1 pour remonter de ligne en ligne :

For I= derniereLigne to 2 Step -1

Il suffit alors de faire le "double" test suivant :
On vérifie que la valeur de la cellule de la ligne testée est égale à moins la valeur de la ligne du dessus, si oui on teste la valeur du mois de la cellule se trouvant à une colonne vers la droite de la cellule testée avec le mois de la cellule décalée d'une colonne du dessus, si oui, alors on peut effacer les deux lignes et on modifie la valeur de I pour "sauter" la ligne du dessus qui vient d'être effacée, sinon on continue simplement la boucle :

If Cells(I,3).Value = - Cells(i-1,3).Value Then
    If Month(Cells(i,3).Offset(,1)) = Month(Cellsi1,3).Offset(,1) Then
        Cells(i,3).EntireRow.Delete
        Cells(i-1,3).EntireRow.Delete
        i = i  -2
    End If
End If

Puis on ferme la boucle

Next I

Pour éviter de voir tout ce remue ménage

Application.ScreenUpdating = False

Ce qui donne

Sub LRD()
    Application.ScreenUpdating = False
    derniereLigne = Cells(Rows.Count, 3).End(xlUp).Row
    For I = derniereLigne To 2 Step -1
        If Cells(I, 3).Value = -Cells(I - 1, 3).Value Then
            If Month(Cells(I, 3).Offset(, 1)) = Month(Cells(i-1, 3).Offset(, 1) Then
                Cells(I, 3).EntireRow.Delete
                Cells(I - 1, 3).EntireRow.Delete
                I = I - 2
            End If
        End If
    Next I
End Sub

Pas tester sur le fichier "test"

@ bientôt

LouReeD

Le 26/03/2021 à 21:15

Bonsoir,

j'ai essayé votre formule mais elle ne marche pas. j'ai même essayé de lire quelque cours sur le site et essayer de la modifier mais j'y arrive pas. je pense que mon problème se situe dans la boucle et dans la condition. j'ai essayé de faire simple et de juste mettre en couleur les lignes (ainsi pouvoir filtré par couleur) qui s'annulaient mais rien n'y fais. voici la formule que j'utilise

Sub elm()
Dim i As Integer
For i = 6647 To 2 Step -1

If Range("C6647") + Range("C6646") = 0 Then
Range("C6647").Font.ColorIndex = 3
Range("C6646").Font.ColorIndex = 3
End If

Next
End Sub

Quand je fais comme ça, suel les 2 dernières ligne se mettent en couleur. Pouvez-vous me corriger cette formule pour que ça puisse s'applique à toute les lignes ?

j'ai essayéde mettre Range("6647")-1 à la place Range("6646") mais quand je le fais je ne sais plus rajouter le .font.colorindex ( cela ne marche plus)

Le 26/03/2021 à 21:29

Bonsoir,

Première chose le code fourni comportait des erreurs du à mon étourderie ainsi qu'à ma touche "moins" le "tiret du 6" mais du clavier numérique.
du coup des "i-1" se sont transformés en i1 !
Deuxième chose, vos dates ne sont pas des dates...

Je reviens vers vous très vite.

@ bientôt

LouReeD

Le 26/03/2021 à 21:33

Bonsoir,

pour corriger le problème de date je lance une comparaison de texte à partir du 4ième caractère sur 2 caractère avec l'instruction d'extraction d'une sous chaine d'une autre : MID (chaine de caractère à analyser, position du premier caractère extrait, nombre de caractère à extraire), le code :

Sub LRD()
    Application.ScreenUpdating = False
    derniereLigne = Cells(Rows.Count, 3).End(xlUp).Row
    For i = derniereLigne To 3 Step -1
        If Cells(i, 3).Value = -Cells(i - 1, 3).Value Then
            If Mid(Cells(i, 3).Offset(, 1), 4, 2) = Mid(Cells(i - 1, 3).Offset(, 1), 4, 2) Then
                Cells(i, 3).Interior.Color = RGB(255, 0, 0) 'EntireRow.Delete
                Cells(i - 1, 3).Interior.Color = RGB(255, 0, 0) 'EntireRow.Delete
                i = i - 2
            End If
        End If
    Next i
End Sub

Pour le test les cellules passent en rouge, il suffira alors de supprimer ces deux lignes et de les remplacer par celles-ci :

                Cells(i, 3).EntireRow.Delete
                Cells(i - 1, 3).EntireRow.Delete

@ bientôt

LouReeD

Le 26/03/2021 à 22:29

Bonsoir,

Je vous remercie beaucoup. et merci de répondre aussi vite. j'ai utilisé le code et ça marche mais pas complement. Il y'a quand même des cases qui ne sont pas colorées. j'ai du réutilisé le code à chaque fois sur le résultat précédent (5 à 6 fois) avant d'avoir des données completement clean. Vous voulez bien vérifier une dernière fois s'il vous plaît?

Et pour finir les dates ne sont pas necessaire. Plus besoin d'intégrer cette partie de la formule. j'ai juste besoin de mettre en couleur/supprimer le lignes qui s'annulent.

J'aimerais aussi savoir à quoi sert la partie

I = I - 2

Je vous remercie d'avance.

Le 27/03/2021 à 01:20

Bonsoir,

En effet c'est une erreur d'interprétation de ma façon de voir les choses, il faut mettre i = i-1.

C'est pour "sauter" la ligne que l'on teste en plus de la ligne testée !

on teste la ligne n°100, on la compare avec la ligne 99 (i1), si on colorie ces deux lignes alors il faut ensuite tester la ligne 98, donc on doit faire en sorte que dans la boucle précédent i soit égale à 99 pour que l'instruction NEXT décrémente de 1 est tombe sur 98.

Donc 100 = suppression de 99 et 100, next i donne 99 pas bon !
Donc 100 = suppression de 99 et 100, i=i1=99, next i donne 98 là c'est bon !

Par contre, suivant l'ordre d'entrée des données il se peut qu'il faille lancer la procédure plusieurs fois :
en effet si on a -10, -10,10,10 pour le mois de mars (et c'est vrai même si on teste pas le mois) au premier tour on aura bien les deux valeurs centrales qui seront effacées, en effet : 10 n'est pas égale à l'opposé de -10, puis 10 est égale à l'opposé de 10, on efface, il reste donc 10 et 10, si ceux doivent également être effacés alors oui il faut relancer la boucle... Le code ne fonctionne que si les valeurs à supprimer se suivent...

@ bientôt

LouReeD

Le 27/03/2021 à 11:53

Bonjour,

OK. Encore une fois merci beaucoup.

Bonne journée à vous

Le 27/03/2021 à 12:37

Bonjour à tous,

Vois ceci :

Option Explicit
Sub supprime()
Dim a, i As Long, x As Range, e
    With Sheets("Feuil9").Cells(1,2).CurrentRegion
        .EntireRow.Interior.ColorIndex = xlNone
        a = .Value
        With CreateObject("Scripting.Dictionary")
            For i = 2 To UBound(a, 1)
                If a(i, 2) > 0 Then
                    .Item(i) = a(i, 2)
                End If
            Next
            For i = 2 To UBound(a, 1)
                If a(i, 2) < 0 Then
                    For Each e In .keys
                        If a(i, 2) + .Item(e) = 0 Then
                            If x Is Nothing Then
                                Set x = Union(Rows(i), Rows(e))
                            Else
                                Set x = Union(x, Rows(e), Rows(i))
                            End If
                            .Remove e: Exit For
                        End If
                    Next
                End If
            Next
        End With
        'supprime
        'If Not x Is Nothing Then x.EntireRow.Delete
        'surligne
        If Not x Is Nothing Then x.Interior.ColorIndex = 44
    End With
End Sub

klin89

Rechercher des sujets similaires à "supprimer lignes valeurs qui nettent"