Fonction NB.SI_Plus sans limitation

Cette fonction "Plus" permet d'appliquer la fonction NB.SI sans que l'on soit limité au nombre de paramètres imposés par Excel.

Introduction

• C'est la plage de critères (sur une seule ligne) qui détermine le nombre de colonnes à balayer.
• La plage de critères peut comporter des blancs.
• Les cellules vides de la plage de critères permettent d'ignorer cette colonne dans le calcul.
• Sélection de la hauteur du bloc (en ligne).
  • Automatique en ne sélectionnant que la première cellule Gauche/Haut de la plage de recherche.
  • Programmée en sélectionnant la première cellule Gauche/Haut et en étirant sur la ligne souhaitée.

Le classeur

L'emplacement de la plage de critères ne doit pas être obligatoirement à cet endroit ; elle peut être dans un coin perdu de la feuille.

Dans un module général

Coller le code ci-dessous

Function NbSi_Plus(PlageRech As Variant, PlageCritere1 As Range)
Dim i As Integer, e As Integer, N As Integer, C1 As Integer
Dim M As Long, Mcont As Integer, Tot As Long
Dim TBF
Dim Cell As Range
Dim DebL As Long, FinL As Long
Dim DebC As Long, FinC As Long
Dim Col()
Dim Crit()
    'Initialise les filtres
    i = 0
    For Each Cell In PlageRech
        ReDim Preserve Crit(1, i)
        If Cell <> "" Then
            Mcont = Mcont + 1
            Crit(1, i) = Asc(Cell) '60="<" 62=">"
            
            
            If Len(Cell) > 1 Then
                If Asc(Mid(Cell, 2, 1)) = 60 Or Asc(Mid(Cell, 2, 1)) = 62 Then
                    Crit(1, i) = 61
                End If
            End If
            Select Case Crit(1, i)
            Case 60, 62
                Crit(0, i) = Mid(Cell, 2)
            Case 61
                Crit(0, i) = Mid(Cell, 3)
            Case Else
                Crit(0, i) = Cell
            End Select
        Else
            Crit(1, i) = 0
        End If
        i = i + 1
    Next Cell
    
    'Rechercher si bloc ou toute la colonne
    TBF = Split(PlageCritere1.Address, ":")
    DebL = Range(TBF(0)).Row
    DebC = Range(TBF(0)).Column
    If UBound(TBF) > 0 Then
        FinL = Range(TBF(1)).Row
        
    End If
    If DebL = FinL Or FinL = 0 Then
        'faire le tri sur toute la hauteur de la colonne
        FinL = Cells(65536, Range(TBF(0)).Column).End(xlUp).Row
    End If
    FinC = DebC + UBound(Crit, 2)
    
    'Appliquer les filtres
    For i = DebL To FinL
        M = 0: C1 = 0
        For e = DebC To FinC
            If Crit(0, C1) <> "" Then
                'For N = 0 To UBound(Crit, 2)
                    Select Case Crit(1, C1)
                    Case 60
                        If Cells(i, e) < Val(Crit(0, C1)) Then M = M + 1
                    Case 61
                        If Cells(i, e) <> Val(Crit(0, C1)) Then M = M + 1
                    Case 62
                        If Cells(i, e) > Val(Crit(0, C1)) Then M = M + 1
                    Case Is <> 0
                        If Cells(i, e) = CStr(Crit(0, C1)) Then M = M + 1
                    End Select
                
            End If
            C1 = C1 + 1
        Next e
        If M = Mcont Then Tot = Tot + 1
    Next i

    NbSi_Plus = Tot
End Function

Télécharger le classeur

Sur CiJoint avant le 20/09/2008
Si plus sur Cijoint, vous pouvez m'envoyer un MP et je le remettrai.

Fin