Discussion :

[freeman43]

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.

[BENNASR]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[patricktoulon]

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

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

[patricktoulon]

re

@Patricktoulon : pour moi le nombre de valeurs unique, c'est dans le cas ou les doublons sont exeptés.

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

[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

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

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

[freeman43]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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