Este fórum está sendo desativado

[LeandroAndrade]

Boa tarde,

estou com dificuldade para inserir um critério nesta função.
o que eu preciso .
uma função que conte todos valores, porem somente os distintos em uma coluna cheia de valores duplicados, porem preciso de um critério em outra coluna que seria contar todos valores distintos se a data for igual a do critério.

tenho este codigo que só conta sem critério.

Public Function ContarDistinct(intervalo As Range) As Long

Dim celula, valores As New Collection, valor As Variant, achou As Boolean

For Each celula In intervalo

If Trim(celula) <> "" Then

achou = False

For Each valor In valores

If valor = celula Then

achou = True

Exit For

End If

Next

If Not achou Then valores.Add celula.Value

End If

Next

ContarDistinct = valores.Count

Set valores = Nothing

End Function


muito obrigado

[osvaldomp]

Substitua esta linha

Código: Selecionar todos

If Not achou Then valores.Add celula.Value

por esta

Código: Selecionar todos

If Not achou And celula.Offset(, -1).Value = [I3] Then valores.Add celula.Value

solução via fórmula matricial

Código: Selecionar todos

=SOMA(SE(FREQUÊNCIA(C2:C1415;C2:C1415)>0;SE(B2:B1415=I3;1)))

[LeandroAndrade]

Bom dia, Osvaldo e todos do forum

muito obrigado amigo, utilizei a formula matricial ficou show


valew

[LeandroAndrade]

Osvaldo

Só tenho um problema minha base da dados tem mais de 10000 linhas não vou poder utilizar a matricial

e a função criada não esta com critério da data

consegue me auxiliar novamente?

muito obrigado

[LeandroAndrade]

Tenho esta outra função que em outra ocasião o abdallas me ajudou

esta função ela escreve todos valores distintos separados por / e exclui repetido

no caso em ves de escrever quero que ela me traga a contagem destes valores

Function Lookup_concat(Search_string As String, _
Search_in_col As Range, Return_val_col As Range)

Dim i As Long
Dim result As String
Dim unico As New Collection

If Search_string = vbNullString Then
result = ""
Lookup_concat = Trim(result)
End
End If

On Error Resume Next
For i = 1 To Search_in_col.Count
If Search_in_col.Cells(i, 1) = Search_string Then
unico.Add Return_val_col.Cells(i, 1).Value, Return_val_col.Cells(i, 1).Value & "a"
End If
Next
On Error GoTo 0

For i = 1 To unico.Count
result = result & "/" & unico.Item(i)
Next

result = Right(result, Len(result) - 1)
Lookup_concat = Trim(result)

End Function

[osvaldomp]

Osvaldo

... não vou poder utilizar a matricial
Por quais motivos ?

e a função criada não esta com critério da data
A linha que eu sugeri inclui o critério data

[LeandroAndrade]

" A matricial Não posso utilizar pois tenho mais de 10000 linhas na base que vou usar o código
a função troquei a linha e testei mas não deu Certo continua sem critério.

Public Function ContarDistinct(intervalo As Range) As Long

Dim celula, valores As New Collection, valor As Variant, achou As Boolean

For Each celula In intervalo

If Trim(celula) <> "" Then

achou = False

For Each valor In valores

If valor = celula Then

achou = True

Exit For

End If

Next

If Not achou And celula.Offset(, -1).Value = [I3] Then valores.Add celula.Value

End If

Next

ContarDistinct = valores.Count

Set valores = Nothing

End Function

[osvaldomp]

Sugiro que você disponibilize o seu arquivo completo com a fórmula e com a função que você está tentando utilizar.

[LeandroAndrade]

estou postando ele mais resumido devido ser muito pesado

agradeço a atenção

att

[osvaldomp]

Olá, Leandro.

Experimente esta UDF no lugar da sua.

Código: Selecionar todos

Function ContDist()
 Dim r As Range, cont As Long
  Application.Volatile
  For Each r In Sheets("zf2s_12").Range("G2:G" & Sheets("zf2s_12").Cells(Rows.Count, 7).End(3).Row)
   If Application.CountIf(Sheets("zf2s_12").Range("G2:G" & r.Row), r.Value) = 1 And r.Offset(, -3).Value = Range("C2").Value Then cont = cont + 1
  Next r
  ContDist = cont: cont = 0
End Function

Na célula 'C9' coloque =ContDist()

obs.
1. não é preciso colocar o intervalo como argumento da Função, como na sua UDF.
2. ao alterar a data em 'C2' a função atualiza automaticamente (na sua amostra em aprox. 3 seg)