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-dessousFunction 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.
