Formule dans un tableau de donnees tenant compte d'un filtre

Bonjour,

J'ai une formule dans un tableau de données A basée sur un autre tableau de donnée B, cela fonctionne bien, mais je souhaiterais que celle-ci s'adapte au filtre du tableau de donnée B

Un peu comme un sous total, mais avec une formule

vous trouverez un exemple dans le fichier joint

merci par avance pour votre aide

Cordialement

Bonjour

Une proposition. Te convient-elle ?

Option Explicit

Dim fr As Worksheet, tablo, tabloR(), plage As Range, dico As Object
Dim i&, j&, k&, nb&

Sub RésultasFiltrés()

    Set fr = Sheets("Résultats filtrés)")
    tablo = Range("Tableau16371")
    Set dico = CreateObject("Scripting.Dictionary")

    k = 0
    For i = 1 To UBound(tablo, 1)
        If tablo(i, UBound(tablo, 2)) <> "" Then
            If Rows(i + 5).EntireRow.Hidden = False Then
                ReDim Preserve tabloR(1 To UBound(tablo, 2), 1 To k + 1)
                For j = 1 To UBound(tablo, 2)
                        tabloR(j, 1 + k) = tablo(i, j)
                Next j
                dico(tablo(i, UBound(tablo, 2))) = dico(tablo(i, UBound(tablo, 2))) + 1
                k = k + 1
            End If
        End If
    Next i
    Set plage = fr.Range("D5").CurrentRegion.Offset(1, 0)
    Set plage = plage.Resize(plage.Rows.Count - 1, plage.Columns.Count)
    plage.Delete

    'initialisation de la plage des résultats
    With fr.Range("R6:S" & Rows.Count)
        .ClearContents
        .Interior.Color = xlNone
        .Borders.LineStyle = xlNone
    End With

    'Ecriture des résultats
    fr.Range("C6").Resize(UBound(tabloR, 2), UBound(tabloR, 1)) = Application.Transpose(tabloR)
    fr.Range("R6").Resize(dico.Count, 1) = Application.Transpose(dico.keys)
    fr.Range("S6").Resize(dico.Count, 1) = Application.Transpose(dico.items)

    'cosmétiques
    With fr.Range("R6:S" & Application.Max(6, fr.Range("R" & Rows.Count).End(xlUp).Row))
        .Sort key1:=fr.Range("R6"), order1:=xlAscending, Header:=xlNo
        .Interior.Color = RGB(252, 238, 214)
        .Borders.LineStyle = xlContinuous
    End With
    fr.Activate
End Sub

Bye !

Merci

regarderai cela lundi, mais je souhaitais sans VBA, avec formules, mais pourquoi pas, merci

bon weekend

bonjour,

merci gmb,

cela ne fonctionne pas, mais je ne veux pas de VBA aussi compliqué, vais fouiller par des formules

merci