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
Ce document intitulé « VBA - Fonction NB.SI_Plus » issu de Comment Ça Marche (www.commentcamarche.net) est mis à disposition sous les termes de la licence Creative Commons. Vous pouvez copier, modifier des copies de cette page, dans les conditions fixées par la licence, tant que cette note apparaît clairement.