Dénombrer éléments différents

[Al09]

Bonjour à tous,

Je cherche le code (pour une macro) pour dénombrer le nombre d'éléments différents.
Par exemple, j'ai le tableau Excel suivant :

Nom
Paul
Pierre
Marie
Paul
Claire
Claire
Fréd

Comment savoir de manière automatique combien il y a de prénoms différents ?

Merci d'avance pour votre aide.

 

[ledzepfred]

Re : Dénombrer éléments différents

bonsoir Al09,

il manque des précisions importantes :

- pourquoi une macro?
-où sont les prénoms (quel feuillet?, quelle colonne?)?
- où veux-tu renvoyer le nb de prénoms (Msgbox? colonne adjacente?)?

Dans l'attente de te lire

A+

 

[ironangel]

Re : Dénombrer éléments différents

Salut Amélie,

je te conseille d'être plus explicite dans ta demande sur le forum, de cette maniere les gens comprendrons mieux et pourrons t'aider, sinon, tu n'auras pas de réponses et du coup tu ne pourras pas avancer,

good luck ;-)

 

[Catrice]

Re : Dénombrer éléments différents

Bonsoir,

ci-joint une formule et une macro à tester

 

[ledzepfred]

Re : Dénombrer éléments différents

bonsoir,

une possibilité :

Sub compteprenom()
  Dim MonDico As Object, Cel As Range
' Définir un nouveau dictionnaire
  Set MonDico = CreateObject("Scripting.Dictionary")
  ' Pour chaque cellule de ma plage
           For Each Cel In Range("A2:A" & Range("A65536").End(xlUp).Row)
              ' On ajoute la valeur au DICO = valeur unique
              If Not MonDico.Exists(Cel.Value) Then MonDico.Add Cel.Value, Cel.Value
          Next Cel
MsgBox (MonDico.Count & " prénoms")
End Sub

compte le nb de prénom dans la colonne A

A+

Edit : oups pas rafraichi, bonsoir Catrice

 

[Catrice]

Re : Dénombrer éléments différents

Bonsoir LedZepFred,

Ton code est mieux, le "Exists" c'est plus propre

 

[ledzepfred]

Re : Dénombrer éléments différents

Merci Catrice,

il semble qu'on a eu la même idée au départ

J'aurais jamais proposer une telle formule, total respect!!

Au plaisir de te croiser à nouveau

A+

 

[Cousinhub]

Re : Dénombrer éléments différents

Bonsoir,

si tu n'as pas besoin de récupérer ces valeurs par la suite, tu peux essayer ainsi :

Range("A1:A" & [A65000].End(xlUp).Row).Name = "Plage"
x = [SumProduct(1 / CountIf(Plage, Plage))]

A supposer que la plage va de A1 à Axxxx

 

[Al09]

Re : Dénombrer éléments différents

Salut Amélie,

je te conseille d'être plus explicite dans ta demande sur le forum, de cette maniere les gens comprendrons mieux et pourrons t'aider, sinon, tu n'auras pas de réponses et du coup tu ne pourras pas avancer,

good luck ;-)

Salut Séb,

Qu'as-tu de mieux à faire un soir de stage que de regarder Excel Downloads ?
Je vais peut-être demander à mon chef de mieux expliciter la demande du projet de sorte qu'on bosse ensemble dessus?! Je suis sûre que ça te plaira.

 

[Al09]

Re : Dénombrer éléments différents

Bonsoir Catrice, Ledzepfred et Bhbh,

Merci à vous trois pour vos codes, c'est exactement ce que je cherchais. Votre aide a été très utile.

A bientôt sur le forum.

 

[JeanMarie]

Re : Dénombrer éléments différents

Bonjour

La formule indiquée par Catrice dans son fichier, peut-être simplifiée.

=SOMME(SI(FREQUENCE(EQUIV($A$2:$A$11;$A$2:$A$11;0);LIGNE(A1:A10));1))

Quand on analyse cette formule, on comprend son fonctionnement et la simplification.Ne recopie pas bêtement les formules...
Dis moi ou l'as-tu trouver sous cette forme. ?

PS: je précise aussi que cette formule ne prend pas en compte les cellules vides

=SOMME(SI(FREQUENCE(SI(A2:A11="";"";EQUIV($A$2:$A$11;$A$2:$A$11;0));LIGNE(1:10));1;0))

à valider par Ctrl+Shift+Entrée

@+Jean-Marie

 

[Pyrof]

Re : Dénombrer éléments différents

Bonjour,

Je t'aurais proposé la même solution que Ledzepfied mais en vérifiant la casse des caractère ainsi que les espaces avant et après

For Each Cel In Range("A2:A" & Range("A65536").End(xlUp).Row)
   cel=trim(ucase(cel))
   MonDico(cel)=MonDico(cel)+1
Next Cel

La commande count donne le nombre différent de prénom

et si tu fais x=mondico("CLAIRE"), tu auras le nombre de Claire dans ton fichier

 

[BOISGONTIER]

Re : Dénombrer éléments différents

Bonsoir,

Comparaison de temps d'exécution:


La fonction personnalisée ItemsDifferents2(champ) est 100 fois + rapide qu'une matricielle.

Sub essai1()
[B]  '1,42 s[/B]
  t = Timer
  Range("A1:A4000").Name = "Champ"
  n = [SumProduct(1 / CountIf(champ, champ))]
  MsgBox Timer() - t
  MsgBox n
End Sub

Sub essai2()
[B]  '1,20 s[/B]
  t = Timer
  Range("A1:A4000").Name = "Champ"
  n = [count(1/Frequency(match(champ,champ,0),row(1:4000)))]
  MsgBox Timer() - t
  MsgBox n
End Sub

Sub essai3()
[B]  ' 0,07 sec[/B]
  t = Timer
  n = ItemsDifferents([A1:A4000])
  MsgBox Timer() - t
  MsgBox n
End Sub

Sub essai4()
[B]  ' 0,015 sec[/B]
  t = Timer
  n = ItemsDifferents2([A1:A4000])
  MsgBox Timer() - t
  MsgBox n
End Sub

Function ItemsDifferents(champ)
  Set MonDico = CreateObject("Scripting.Dictionary")
  For Each c In champ
    MonDico(c.Value) = c.Value
  Next c
  ItemsDifferents = MonDico.Count
End Function

Function ItemsDifferents2(champ)
  Set MonDico = CreateObject("Scripting.Dictionary")
  a = champ
  For Each c In a
    MonDico(c) = c
  Next c
  ItemsDifferents2 = MonDico.Count
End Function

Avec critère:

Function ItemsDifferentsCritere(champ, champcritere, critere)
  Set MonDico = CreateObject("Scripting.Dictionary")
  a = champ
  b = champcritere
  For i = 1 To champ.Count
    If b(i, 1) = critere And a(i, 1) <> "" Then
       temp = a(i, 1)
       MonDico(temp) = temp
    End If
   Next i
   ItemsDifferentsCritere = MonDico.Count
End Function

Mot le fréquent (0,04 s pour 4000 items):

Function MotPlusFrequent(champ)
  Set MonDico = CreateObject("Scripting.Dictionary")
  a = champ
  For Each c In a
     MonDico(c) = IIf(MonDico.exists(c), MonDico(c) + 1, 1)
  Next c
  m = 0
  For Each c In MonDico
    If MonDico.Item(c) > m Then m = MonDico.Item(c): temp = c
  Next c
  MotPlusFrequent = temp
End Function

JB

 

[Pyrof]

Re : Dénombrer éléments différents

Bonjour,
Avec une seule boucle
Je n'ai pas fait de test de temps .....

Function MotPlusFrequent(champ)
  Set MonDico = CreateObject("Scripting.Dictionary")
  a = champ
  Maxi = 0
  For Each c In a
    tmp = MonDico(c) + 1
    MonDico(c) = tmp
    If tmp > Maxi Then
        Maxi = tmp
        MotPlusFrequent = c
    End If
  Next c
End Function

 

[BOISGONTIER]

Re : Dénombrer éléments différents

Bonjour,

-La suppression d'une boucle ne modifie pas le temps (plus de tests)
-Mondico(c)=Mondico(c)+1 fait passer de 0,04s à 0,02s

Ce que je voulais montrer (aux ayatollas du matriciel), c'est la lenteur de certaines formules matricielles .

JB