Suppression de lignes en fonction du contenu d'une cellule

Question

Je souhaiterai obtenir un programme, qui me permettrait de supprimer une ligne en fonction du contenu d'une précédente cellule d'une colonne particulière pour chaque feuille de mon fichier Excel. Concrètement dans le fichier dans lequel je travaille, je veux que mon programme supprime la deuxième ligne (ligne l+2), qui suit la ligne (l) dont le contenu de la colonne B est "Memo: Preferred Dividends Related to the Period". Puis, je veux qu'il supprime la deuxième ligne(k+2), qui la ligne (k) dont le contenu de la colonne B est "Memo: Fitch Eligible Capital". Quelqu'un aurait-il une idée de programme, qui ferait l'affaire ? Voici le lien du fichier sur lequel je travaille. https://www.fichier-xls.fr/2016/07/06/hungary1/ Merci d'avance Etrof...

MFerrand · Answer

Un fichier plus réduit conviendrait pour la démonstration... Le problème que tu poses est simple, mais la solution comporte un risque : la macro opèrera en remontant du bas vers le haut (comme toujours quand on supprime) pour rechercher tes conditions mais ne supprimant pas les lignes déterminant les conditions, tant qu'il existe ces conditions, la macro trouvera toujours à supprimer si on l'exécute plusieurs fois... Cordialement...

MFerrand · Answer

J'avoue que l'organisation de ton fichier n'est guère de nature à m'inspirer ...

Voilà une procédure qui devrait faire l'affaire... Non testée car visiblement ton fichier ne contient aucune des mentions recherchée !

Sub SuppressionLignes()
    Dim ws As Worksheet, c As Range, Suppr(), mem$, adrc$, i%, j%
    For Each ws In Worksheets
        ReDim Suppr(0)
        mem = "Memo: Preferred Dividends Related to the Period"
        With ws.Columns("B")
            Set c = .Find(mem, , , xlWhole)
            If Not c Is Nothing Then
                Suppr(0) = Suppr(0) + 1: ReDim Preserve Suppr(Suppr(0))
                Suppr(Suppr(0)) = c.Row + 2: adrc = c.Address
                Do
                    Set c = .FindNext(c)
                    If Not c Is Nothing Then
                        Suppr(0) = Suppr(0) + 1: ReDim Preserve Suppr(Suppr(0))
                        Suppr(Suppr(0)) = c.Row + 2
                    End If
                Loop While Not c Is Nothing And c.Address <> adrc
            End If
        End With
        mem = "Memo: Fitch Eligible Capital"
        With ws.Columns("B")
            Set c = .Find(mem, , , xlWhole)
            If Not c Is Nothing Then
                Suppr(0) = Suppr(0) + 1: ReDim Preserve Suppr(Suppr(0))
                Suppr(Suppr(0)) = c.Row + 2: adrc = c.Address
                Do
                    Set c = .FindNext(c)
                    If Not c Is Nothing Then
                        Suppr(0) = Suppr(0) + 1: ReDim Preserve Suppr(Suppr(0))
                        Suppr(Suppr(0)) = c.Row + 2
                    End If
                Loop While Not c Is Nothing And c.Address <> adrc
            End If
        End With
        If Suppr(0) > 0 Then
            For i = 1 To UBound(Suppr) - 1
                For j = i + 1 To UBound(Suppr)
                    If Suppr(j) > Suppr(i) Then
                        Suppr(0) = Suppr(j): Suppr(j) = Suppr(i): Suppr(i) = Suppr(0)
                    End If
                Next j
            Next i
            Application.ScreenUpdating = False
            For i = 1 To UBound(Suppr)
                ws.Rows(i).Delete
            Next i
            Application.ScreenUpdating = True
        End If
    Next ws
End Sub

MFerrand · Answer

Désolé pour toi mais en B194 de la première feuille, je lis ceci :

        Fitch Comprehensive Income

J'ajoute qu'avant de dire que tes feuilles ne comportaient pas les mentions cherchées, j'avais vérifié par une recherche manuelle des deux expressions sur les 3 feuilles. Infructueuse !

Mais j'observe ci-dessus que que l'expression est précédée d'un certain nombre d'espaces ! Je te fais donc remarquer au cas où cela serait utile, qu'une espace est un caractère comme les autres, et qu'il n'en figurait pas dans les recherches demandées.

Il te faut donc corriger les mentions recherchées, ou bien choisir le paramètre xlPart à la place de xlWhole pour la recherche.

Cordialement.

MFerrand · Answer

Je ne vois pas pourquoi mais la reconnaissance ne se fait pas...

Changement de méthode :

Sub SuppressionLignes()
    Dim ws As Worksheet, Suppr(), mem$, i%, j%, n%
    For Each ws In Worksheets
        ReDim Suppr(0): n = ws.Cells(ws.Rows.Count, 2).End(xlUp).Row
        mem = "Memo: Preferred Dividends Related to the Period"
        For i = 1 To n
            If Trim(ws.Cells(i, 2).Text) = mem Then
                Suppr(0) = Suppr(0) + 1: ReDim Preserve Suppr(Suppr(0))
                Suppr(Suppr(0)) = ws.Cells(i, 2).Row + 2
            End If
        Next i
        mem = "Memo: Fitch Eligible Capital"
        For i = 1 To n
            If Trim(ws.Cells(i, 2).Text) = mem Then
                Suppr(0) = Suppr(0) + 1: ReDim Preserve Suppr(Suppr(0))
                Suppr(Suppr(0)) = ws.Cells(i, 2).Row + 2
            End If
        Next i
        On Error GoTo 0
        If Suppr(0) > 0 Then
            For i = 1 To UBound(Suppr) - 1
                For j = i + 1 To UBound(Suppr)
                    If Suppr(j) > Suppr(i) Then
                        Suppr(0) = Suppr(j): Suppr(j) = Suppr(i): Suppr(i) = Suppr(0)
                    End If
                Next j
            Next i
            Application.ScreenUpdating = False
            For i = 1 To UBound(Suppr)
                ws.Rows(Suppr(i)).Delete
            Next i
            Application.ScreenUpdating = True
        End If
    Next ws
End Sub

A essayer.

MFerrand · Answer

Dans le cas où tu veux garder la ligne, il faut l'effacer au lieu de la supprimer.

        mem = "Government held Hybrid Capital"
        For i = 1 To n
            If Trim(ws.Cells(i, 2).Text) = mem Then
                .Rows(i + 2).Clearcontents
            End If
        Next i

Tu supprimes les deux lignes dans la condition If... End If qui enregistrent les lignes à supprimer dans un tableau, et les remplace par l'effacement de la ligne qui peut être effectué directement.

[La suppression est faite globalement pour chaque feuille après avoir enregistré toutes les lignes à supprimer, après On Error GoTo 0 (NB- cette ligne est d'ailleurs à supprimer dans le code, oubli d'une version antérieure, elle met fin à une gestion d'erreur qui a été supprimée du code...). ]