Application.Countifs valeur unique

Version imprimable

09/10/2018, 10h50
freeman43

Application.Countifs valeur unique

Bonjour,

j'ai développé pour mon entreprise une macros VBA qui me permet de compter les valeurs unique d' une plage passé en paramètre suite à l'application d'un filtre.
Or l'application de filtre est lourd est prend beaucoup de temps et ma question est la suivantes :

Existe-t-il une fonction VBA du style :"application.countifs.Unique" afin de retourner directement ce nombre.

bonjour
Affiche ton code, peut etre y a des chose à améliorer car selon les experts de ce super site la méthode la plus rapide et plus conseillée est la méthode de filtre
une méthode avec boucle qui va consommer plus de temps à tester
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 Sub compterSansDoublons() Dim unique As New Collection Dim i As Integer On Error Resume Next Application.ScreenUpdating = False For Each cel In Range("A2:A" & [A65000].End(xlUp).Row) If Cells(cel.Row, 1) <> "" Then unique.Add cel.Value, CStr(cel.Value) End If Next cel MsgBox unique.Count End Sub
BONNE CONTINUATION

09/10/2018, 11h11
patricktoulon

re

re
bonjour

encore une question a double sens qui en meme temps n'en a pas

en fait tout depends de ce que tu cherche

valeur unique ca veux dire quoi pour toi????????

des valeurs qui n'existent qu'une seule fois dans la plage??????

ou

des valeurs dont les doublons sont exeptés?????

ca n'est pas la meme chose

dans le cas de doublons exeptés le code de bennnasr peut convenir

dans le cas de valeur existante et unique ca ne convient pas
09/10/2018, 11h14
freeman43

Bonjour,

Justement j'utilise cet même fonction.
Mon problème est que j'utilise beaucoup de filtre dans mon code et le temps d'application d'un filtre est long.
Donc j'aurai voulu savoir si il y avais une fonction native du VBA afin de remplacer l'utilisation de filtre afin de retourner ce nombre de valeurs Unique.

@Patricktoulon : pour moi le nombre de valeurs unique, c'est dans le cas ou les doublons sont exeptés.
09/10/2018, 13h41
patricktoulon

re

re

Citation:

@Patricktoulon : pour moi le nombre de valeurs unique, c'est dans le cas ou les doublons sont exeptés.
https://forum.developpez.be/images/misc/progress.gif

dans ce cas on parle d'extraction unique(sans doublons) pas de valeurs uniques
et oui il y a une methode simple et rapide
copie le sheets sur une autre feuille(ajoutée pour l'ocasion si necessaire
et dans ce nouveau sheet un removeduplicate sur la colonne de ton choix
09/10/2018, 14h33
Philippe Tulliez

Bonjour,
Nul besoin de VBA pour effectuer ce calcul.
A lire Comment compter le nombre de valeurs distinctes dans une colonne d’excel
09/10/2018, 20h08
freeman43

Bonsoir,

Je veux en VBA connaitre le nombre de valeurs unique d'une colonne après avoir appliqué un filtré sur d'autres colonne mais sans utiliser Autofilter.
09/10/2018, 21h45
pijaku

Freeman,
Je présume que ta langue maternelle n'est pas le français.
Appliquer un filtre sans autofilter (ou sans autre possibilité de filtre) me semble impossible.
Non?
Je ne penses pas non plus que tu aies besoin de vba pour ça. Sauf s'il s'agit d'un exercice scolaire.
Suit le lien indiqué plus haut (par Phillipe thuilliez que je salue au passage) et tu as ta solution...

Bonjour,

Justement, je pose la question, si ces possible. Je la pose car avec la fonction Countifs et Sumifs, on peux mettre des conditions.
De plus j'utilise VBA car je lance tous les jours ma macros qui calcul pour chaque mois des valeurs et que mes données change de jours en jours et me permet d'automatiser le calcul.

Pour chaque mois j'exécute 20 filtre à la suite et au final cela fait 240 filtre qui se fait certaine fois en 20 s et d'autre fois en 4 min.
Je veux éviter justement que certain jour cela dure 4 min certain jour, mais je ne sais pas d’où vient le problème.

J'évite d'utiliser la fonction ShowAllData afin d'éviter d’alourdir le temps d’exécution.
Voici un extrait de mon code :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
 
Ws.Rows("1:1").AutoFilter
For u = O To 15
If u > 11 Then
Years = Reinit_Year + 1
End If
InitLigne = ReinitCell
If Month = 13 Then Exit For
x = "01/" & Month & " /" & Years
LDate1 = Format(x, "dd/mm/yyyy")
LDate = Format(LDate1, "mm/dd/yyyy")
DerniereLigne = Ws.Range("A65536").End(xlUp).Row
Decal_Cell = Decal_Cell + 2
'-------------------------------------J3M A réaliser------------------------------------------------
'ZTD cl_ de Site : Colonne Y
    Ws.Range("$A$1:$DD$" & DerniereLigne).AutoFilter Field:=ColZone, Criteria1:="PMI-RI"
'Imb valider par UPR
    Ws.Range("$A$1:$DD$" & DerniereLigne).AutoFilter Field:=ColIMBUPR, Operator:= _
        xlFilterValues, Criteria1:=Array("ATTENTE REALISATION PRE-ETUDE", "PRE-ETUDE A VALIDER", "SIGNE")
'J3M du mois deadline J3M  AV
    Ws.Range("$A$1:$DD$" & DerniereLigne).AutoFilter Field:=Col, Operator:= _
        xlFilterValues, Criteria2:=Array(1, LDate)
 
Set PlageHD = Ws.Range("F2:F" & Ws.[A65000].End(xlUp).Row).SpecialCells(xlVisible)
J3M = Calcul_FIS(PlageHD)
 
Cell6 = Cells(InitLigne, Decal_Cell).Address
Wf.Range(Cell6) = J3M
'-------------------------------------J3M OK------------------------------------------------
'J3M ok Statut J3M ZTD HD (3 mois)Colone AY
    Ws.Range("$A$1:$DD$" & DerniereLigne).AutoFilter Field:=ColStatus, Criteria1:="J3M OK"
 
Set PlageHD = Ws.Range("F2:F" & Ws.[A65000].End(xlUp).Row).SpecialCells(xlVisible)
J3M_OK = Calcul_FIS(PlageHD)
 
InitLigne = InitLigne + 1
Cell21 = Cells(InitLigne, Decal_Cell).Address
Wf.Range(Cell21) = J3M_OK
 
.................

Voici le code de la fonction appelé :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
 
'------------------------------------nb de fis unique-----------------------------------------
Function Calcul_FIS(PlageHD2) As Integer
'MsgBox PlageHD2
Dim unique As New Collection
Dim i As String
Set unique = Nothing
i = 0
On Error Resume Next
For Each Cel In PlageHD2
    If Cel.Address = Cells(1, ColRS).Address Then
    i = 0
    Exit For
    End If
    If Cel.Value <> "" Then
        unique.Add Cel.Value, CStr(Cel.Value)
    Else
        i = i + 1
    End If
Next Cel
On Error GoTo 0
Calcul_FIS = unique.Count + i
End Function

Voila si cela peux aider.
Concernant mon français, je te remercie pour ta remarque....;););)