Microsoft 365 Supprimer sous-totaux négatifs dans une liste

=FILTRE($A$2:$B$910;SOMME.SI.ENS($B$2:$B$910;$A$2:$A$910;$A$2:$A$910)>0)

Sub Sous_totaux()
Dim tablo, deb&, x, i&
Application.ScreenUpdating = False
With [A1].CurrentRegion
    .Sort .Cells(1), xlAscending, Header:=xlYes 'tri initial
    tablo = .Resize(, 2) 'matrice, plus rapide
    deb = 1: x = tablo(deb, 1)
    For i = 2 To UBound(tablo)
        If tablo(i, 1) = x Then
            tablo(i, 1) = "#N/A"
            tablo(deb, 2) = tablo(deb, 2) + tablo(i, 2)
        Else
            deb = i: x = tablo(deb, 1)
        End If
    Next
    .Resize(, 2) = tablo
    .Sort .Cells(1), xlAscending, Header:=xlYes 'tri pour regrouper et accélérer
    On Error Resume Next 'si aucune SpecialCell
    Intersect(.SpecialCells(xlCellTypeConstants, 16).EntireRow, .Cells).Delete xlUp 'supprime les doublons
    .Replace "-*", "#N/A"
    .Sort .Cells(1, 2), xlAscending, Header:=xlYes 'tri pour regrouper et accélérer
    Intersect(.SpecialCells(xlCellTypeConstants, 16).EntireRow, .Cells).Delete xlUp 'supprime les Sous-totaux négatifs
    .Sort .Cells(1), xlAscending, Header:=xlYes 'tri initial
End With
With ActiveSheet.UsedRange: End With 'actualise la barre de défilement verticale
End Sub

Sub Suppression_sous_totaux_negatifs()
Dim tablo, ub&, resu, deb&, x, i&, j&
Application.ScreenUpdating = False
With [A1].CurrentRegion
    .Sort .Cells(1), xlAscending, Header:=xlYes 'tri initial
    tablo = .Resize(, 2) 'matrice, plus rapide
    ub = UBound(tablo)
    ReDim resu(1 To ub, 1 To 1)
    deb = 1: x = tablo(deb, 1)
    For i = 2 To ub
        If tablo(i, 1) = x Then
            resu(deb, 1) = resu(deb, 1) + tablo(i, 2)
        Else
            resu(i, 1) = tablo(i, 2)
            deb = i: x = tablo(deb, 1)
        End If
    Next i
    For i = 2 To ub
        If resu(i, 1) < 0 Then
            resu(i, 1) = ""
            For j = i To ub
                If resu(j, 1) <> "" Then i = j - 1: Exit For
                resu(j, 1) = "#N/A"
            Next j
        End If
    Next i
    .Columns(1).Insert xlToRight 'insère une colonne auxiliaire
    .Columns(0) = resu 'restitution
    On Error Resume Next 'si aucune SpecialCell
    Union(.Columns(0), .Cells).Sort .Cells(1, 0), xlAscending, Header:=xlYes 'tri pour regrouper et accélérer
    Intersect(.Columns(0).SpecialCells(xlCellTypeConstants, 16).EntireRow, .Cells).Delete xlUp 'supprime les Sous-totaux négatifs
    .Columns(0).Delete xlToLeft 'supprime la colonne auxiliaire
    .Sort .Cells(1), xlAscending, Header:=xlYes 'tri initial
End With
With ActiveSheet.UsedRange: End With 'actualise la barre de défilement verticale
End Sub

=LET(d;A2:A910;m;B2:B910;u;UNIQUE(d);st;BYROW(u;LAMBDA(p;SOMME.SI.ENS(m;d;p)));FILTRE(ASSEMB.H(u;st);st>0))