VBA - Função NB.SI_Plus
Com esta função "Plus" você pode aplicar a função NB.SI sem se limitar ao número de parâmetros impostos pelo Excel.
Introdução
- É a zona de critérios (em uma só linha) que determina o número de colunas a serem deletadas.
- A zona de critérios pode incluir espaços em branco.
- Com as células vazias da zona de critérios é possível ignorar esta coluna no cálculo.
- Seleção da altura do bloco (on-line).
- Automática, selecionando apenas a primeira célula da esquerda /do topo da zona de busca.
- Programada, selecionando a primeira célula da esquerda/do topo e prolongando para a linha desejada.
A pasta de trabalho
A localização da zona de critérios não precisa estar, obrigatoriamente, neste lugar; ela pode estar em um canto qualquer da planilha.
No módulo geral
Colar o código abaixo
Function NbSi_Plus(PlageRech As Variant, TrechoCritério1 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()
'Initializa os filtros
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
'Verificar se bloco ou coluna inteira
TBF = Split(TrechoCritério1.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
'classificar o topo da coluna
FinL = Cells(65536, Range(TBF(0)).Column).End(xlUp).Row
End If
FinC = DebC + UBound(Crit, 2)
'Aplicar os filtros
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
Download da Planilha
Se você precisar, envie uma Mensagem Privada ao autor da dica para receber o link.
lermite222
