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
Cet article est régulièrement mis à jour par des experts sous la direction de Jean-François Pillou, fondateur de CommentCaMarche et directeur délégué au développement numérique du groupe Figaro.
