Sous.total selon critère sur liste filtrée

[Compte Supprimé 979]

Bonjour à tous,

Quelqu'un connait-il une formule miracle pour faire le sous total (ou total) de lignes filtrées selon une condition

Je peux faire un truc en VBA

Mais je me demandais si par formule ce n'étais pas possible

Vois fichier joint pour une meilleur compréhension

D'avance meri.

A+

 

[Bens7]

Re : Sous.total selon critère sur liste filtrée

Bonjour ! j;ai ouvert un nouveaux sujet a ce propos pour 2 conditions
mais rien personne peut etr pourriez vous m'aider svp voici ci joint exactement ce que jai besoin !
merci encore

 

[Compte Supprimé 979]

Re : Sous.total selon critère sur liste filtrée

Salut Bens7,

Peut-être avec une fonction personnalisée, tel que celle-ci
A mettre dans un module

Option Explicit


Function Calcul(Rng As Range, Quoi As String)

  Dim Col As Integer, ColDeb As Integer, NbCol As Integer
  Dim Lig As Long, LigDeb As Long, NbLig As Long
  Dim Tot As Integer, Mem As String
  Application.Volatile
  ' Initialisation des variables
  ColDeb = Rng.Column: NbCol = Rng.Columns.Count
  LigDeb = Rng.Row: NbLig = Rng.Rows.Count
  Tot = 0: Mem = ""
  ' Pour chaque colonne de la plage de cellules
  For Col = ColDeb To ColDeb + NbCol - 1
    ' Pour chaque ligne de la plage de cellules
    For Lig = LigDeb To LigDeb + NbLig - 1
      ' Si la cellule contient le terme cherché
      If Cells(Lig, Col).Value = Quoi Then
        ' On ajoute au total
        Tot = Tot + 1
        ' On mémorise la dernière valeur trouvée
        Mem = Cells(Lig, Col).Value
      ElseIf Cells(Lig, Col).Value <> "" Then
        ' Si la cellule n'est pas vide mais ne correspond pas
        ' On mémorise la dernière valeur trouvée
        Mem = Cells(Lig, Col).Value
      ElseIf Tot >= 1 And IsEmpty(Cells(Lig, Col)) And Mem = Quoi Then
        ' Si le total est >= 1
        ' et que la cellule est vide
        ' mais que la dernière valeur mémorisée correspond
        ' On ajoute au total
        Tot = Tot + 1
      End If
    Next Lig
  Next Col
  ' Renvoyer le total
  Calcul = Tot
End Function

 

[Calvus]

Bonsoir,

Je déterre ce sujet car je cherchais la solution à mon problème de Sous-Total avec critère.
J'ai trouvé ici !

Donc simplement pour dire : Génial !

Et saluer les copains au passage, regrettant infiniment les absences de Tibo et Hoerwind..
Bien le bonjour à Job et Bruno.

 

[gosselien]

Bonjour,

depuis 2010, il y a agregat() qui permet aussi un travail sur les lignes masquées / non - masquées

=AGREGAT(9;5;B2:B7)

P.

 

[Calvus]

Bonjour Gosselien, le forum,

Merci pour cette info qui peut en intéresser pas mal.
Pour ma part, je suis sous 2007, ça ne fonctionne donc pas.
Bonne journée.