Effacer des sous totaux et les lignes qui les composent

Bonjour,

Voilà mon problème : j'effectue des sous totaux de deux colonnes. Quand les sous totaux des deux colonnes sont égaux, j'aimerai supprimer ces sous totaux et les lignes qui les composent. Je joins un fichier pour explication. Je n'ai mis dans ce fichier que quelques lignes mais il faut s'imaginer un fichier beaucoup plus gros et j'aimerai savoir s'il existe une solution rapide sans faire les suppression manuellement.

Merci de bien vouloir m'aider.

HRC

Bonjour,

une solution via une macro

Sub test()
    On Error Resume Next
' on efface la feuille résultat si elle existe
    Application.DisplayAlerts = False
    Worksheets("feuille résultat").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True
' on prend un copie de la feuille départ
    Worksheets("Feuille départ").Copy after:=Worksheets(Worksheets.Count)
    Set ws = Worksheets(Worksheets.Count)
    With ws
        .Name = "Feuille résultat" ' on renomme la copie en feuille résultat
        dl = .Range("a" & Rows.Count).End(xlUp).Row - 1 ' dl dernière ligne avant total general
        For i = dl To 2 Step -1 ' on parcourt les lignes
            If Left(.Cells(i, 1), 5) = "Total" Then 'si ligne total trouvée
                If .Cells(i, 2) = .Cells(i, 3) Then ' si montants sont égaux
                    supprime = Replace(.Cells(i, 1), "Total ", "") ' supprime contient le nom pour lequel il faut supprimer les lignes
                    .Rows(i).Delete shift:=xlUp ' on supprime la ligne total
                Else
                    supprime = "" ' pas de ligne à supprimer
                End If
            Else
                If supprime = .Cells(i, 1) Then .Rows(i).Delete shift:=xlUp ' on trouve une ligne avec le nom à supprimer
            End If
        Next i
    End With
    Set ws = Nothing
End Sub

Merci beaucoup à h2so4, ça a l'air de marcher.

Bonne soirée

HRC