VBA - Fonction NB.SI_Plus

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

Si besoin, vous pouvez m'envoyer un MP et je le remettrai.

Fin