Compter le nombre de dates uniques dans une colonne

[Mercure67]

Bonjour, j'ai besoin de votre aide, mes recherches étant restées vaines et mon expertise plutôt de niveau débutant. Mon problème est le suivant :
Dans une plage de A5 à A400, j'ai une liste de dates et des cellules vides. Je souhaite compter le nombre de dates sans doublons dans cette plage. Mais comment faire ...
D'avance merci.

 

[Staple1600]

Bonne nuit le fil, le forum

Une solution par formules
1)
(ne fonctionne qui si pas de cellules vides dans la colonne)
=SOMMEPROD(1/NB.SI(A5:A400;A5:A400))

2) si présence de cellules vides dans la colonne
à valider avec : CTRL+SHIFT ENTER (c'est une formule matricielle)
=SOMMEPROD((A5:A400<>"")/NB.SI(A5:A400;A5:A400&""))

 

[mapomme]

Bonjour à tous, à Staple1600 😉,

Une autre formule matricielle à valider par Ctrl+Shift+Entrée.

=SOMME(SI(A5:A400="";0;N(EQUIV(A5:A400;A5:A400;0)=LIGNE(A5:A400)-4)))

Le 4 du terme -4 dans la formule provient du numéro de la première ligne de la plage (ligne n°5) diminué de 1.

 

[pascal82]

Bonjour à tous, Mercure67, Staple1600 et mapomme,

Une autre option par macro

Bonne journée

Sub Valeurs_Uniques()
Dim MaPlage As Range

    Set MaPlage = ActiveSheet.Range("A5:A500") 'sélection de la plage de cellules

    ValeursUniques = ValeursUniquesDansPlage(MaPlage) 'appel de la fonction "ValeursUniquesDansPlage"
  
    'Cells(1, 2) = ValeursUniques 'affiche le resultat de valeurs uniques dans la cellule B1

    MsgBox ValeursUniques 'affiche le nombre des valeurs uniques
    Exit Sub

End Sub
Public Function ValeursUniquesDansPlage(MaPlage As Range)
Dim N As Long
Dim Compteur As Long
Dim Ligne As String
Dim Valeur As String
Dim NombreDeValeursUniques As Long
Dim ValeursUniques() As String
    'valeurs par défaut
    N = 0
    Compteur = 0
    Ligne = ""
    Valeur = ""
    NombreDeValeursUniques = 0
  
    N = MaPlage.Count
    ReDim ValeursUniques(0 To N)
    'itération dans la Plage
    If (N > 0) Then
        For Compteur = 1 To N
            Valeur = CStr(MaPlage.Cells(Compteur).Value)
            If (Not (InStr(1, Ligne, Valeur, vbBinaryCompare) > 0)) Then
                Ligne = Ligne & ("[" & Valeur & "]")
                NombreDeValeursUniques = NombreDeValeursUniques + 1
                ValeursUniques(NombreDeValeursUniques) = Valeur
            End If
        Next Compteur
    End If
    'résultat final
    ValeursUniquesDansPlage = NombreDeValeursUniques
    Exit Function

End Function

 

[mapomme]

Bonjour Mercure67 et à tous les autres 🙂,

Pour le FUN, une comparaison en durée d'exécution des formules et code VBA.

Compléter les cellules D1 et D2. Cliquer sur le bouton en face de chaque méthode pour en calculer le résultat et le temps d’exécution. Les méthodes :

1. via VBA en utilisant un dictionary
2. via formule matricielle utilisant la fonction EQUIV
3. via formule matricielle utilisant la fonction NB.SI
4. via VBA avec une fonction personnalisée ValeursUniquesDansPlage()

Nota : le code de la fonction ValeursUniquesDansPlage() a été modifié par ma pomme. La valeur à rechercher dans Ligne doit être entourée de crochets [...].
Supposons que Ligne contienne la valeur [x123] et pas x12. Si par la suite on recherche simplement la valeur x12 alors, InStr(1, Ligne, Valeur, vbBinaryCompare) sera supérieur à 0 (on trouvera le x12 de [x123] ). Ce qui laisserait croire que x12 a déjà été rencontré, et ce n'est pas le cas. En cherchant [x12], InStr(1, Ligne, Valeur, vbBinaryCompare) retourne bien 0. Par voie de conséquence, on a aussi éliminé les valeurs vides.

Attention ! le fichier passe en calcul manuel à l’ouverture. Il doit normalement repasser en mode automatique à la fermeture. A vérifier par vos soins.

 

[pascal82]

Bonjour à tous,

@mapomme: Merci pour cette précision, cependant comme beaucoup j'ai appris le VBA en consultant les discussions du site. Tout n'est pas parfait et probablement perfectible. Je vais donc essayer de comprendre en réalisant plusieurs tests.

L'objectif principale du message était d'apporter une option supplémentaire, en sachant que la vitesse d'exécution n'était pas un critère initial et surtout que vos formules proposées, Stapple et vous, répondaient a la demande.

Merci encore à vous

Cordialement

 

[mapomme]

Re,

@mapomme: Merci pour cette précision, cependant comme beaucoup j'ai appris le VBA en consultant les discussions du site. Tout n'est pas parfait et probablement perfectible. Je vais donc essayer de comprendre en réalisant plusieurs tests.

En fait, la modification que j'ai faite, c'est parce que j'avais déjà commis cet oubli de ne pas entourer la valeur cherchée par les séparateurs.

L'objectif principale du message était d'apporter une option supplémentaire,

La fonction personnalisée est une bonne idée. Je vais faire de même avec la méthode "dictionary" dans le prochain message.

 

[mapomme]

Re à tous,

Une version v2 où la méthode avec "dictionary" a été transformée en fonction personnalisée utilisable soit sur la feuille de calcul : =Compter_Uniq(Plage) soit en VBA.

Function Compter_Uniq&(xPlage As Range)
Dim dico, tablo, i&, k&

   Set dico = CreateObject("scripting.dictionary")
   tablo = xPlage.Value: k = xPlage.Count
   For i = 1 To k
      If tablo(i, 1) <> "" Then dico(tablo(i, 1)) = ""
   Next i
   Compter_Uniq = dico.Count
End Function

 

[Mercure67]

Bonjour à tous,

Merci pour vos réponses. Grâce à vous mon problème a trouvé une solution. J’ai opté pour =SOMMEPROD((A5:A400<>"")/NB.SI(A5:A400;A5:A400&"")) , solution proposée par Staple1600. Je l’avais déjà trouvé mais il manquait le Ctrl Shift Enter !

Encore merci pour votre aide.

 

[Staple1600]

Bonsoir le fil, le forum

C'était pourtant précisé 😉
Bon, là, tu peux pas le louper 😉

Bonne nuit le fil, le forum

2) si présence de cellules vides dans la colonne
à valider avec : CTRL+SHIFT ENTER (c'est une formule matricielle)
=SOMMEPROD((A5:A400<>"")/NB.SI(A5:A400;A5:A400&""))

 

[mapomme]

Bonsoir,

Mais c'est qu'ils vont finir par nous l'énerver le Staple1600 🙂😉😀😛

 

[Staple1600]

Bonsoir mapomme

Pas très flatteur ton portrait 😉
Quoique au niveau tignasse, ça se rapproche 😉

PS: Très malin d'avoir joint un PDF en lieu et place d' une image dans le message
Me suis fait avoir comme un bleu 😉