Compter le nombre de cellules identiques d'une même colonne VBA

Bonjour

Je souhaite écrire une macro qui compte le nombres de cellules identiques sur EXCEL avec VBA.

Voici la configuration que j'observe sur une première feuille EXCEL :

nbre1
nbre1
nbre1
nbre2
nbre2
nbre3
nbre3
nbre3
nbre3
....

En gros, je souhaite écrire sur une deuxième feuille ceci :

nbre1 3
nbre2 2
nbre3 4

Je vous remercie

Bonjour,

en découpant la macro en deux étapes, c'est simple :
- faire un tri sans doublon et recopier les valeurs dans la seconde feuille
- appliquer par exemple une formule NB.SI

Si tu rencontres des difficultés sur l'une ou l'autre de ces étapes, dis le nous :)

Ok merci. Je vais essayer çà :D

Bonjour,

Une autre façon de faire, avec deux tables :

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

Sub test() Dim C As Range, Tabl1() As String, Tabl2() As Long, Ctr As Long, Var Ctr = -1 ReDim Tabl1(0) ReDim Tabl2(0) With Sheets("Feuil1") For Each C In .Range(.[A1], .Cells(.Rows.Count, 1).End(xlUp)) Var = Application.Match(C.Value, Tabl1, 0) If Not IsNumeric(Application.Match(C.Value, Tabl1, 0)) Then Ctr = Ctr + 1 ReDim Preserve Tabl1(Ctr) ReDim Preserve Tabl2(Ctr) Tabl1(Ctr) = C.Value Tabl2(Ctr) = Tabl2(Ctr) + 1 Else Tabl2(Var - 1) = Tabl2(Var - 1) + 1 End If Next C End With With Sheets("Feuil2") .[A1].Resize(UBound(Tabl1) + 1) = Application.Transpose(Tabl1) .[B1].Resize(UBound(Tabl1) + 1) = Application.Transpose(Tabl2) End With End Sub

---

Si les valeurs que tu souhaites comparer sont des nombres (comme le suggère ton exemple), je te conseille plutôt d'essayer de voir si tu ne pourrais pas régler ça avec une fonction FREQUENCE() en matriciel.

Si c'est du texte et que tu as déjà la liste des valeurs possibles, tu peux utiliser la fonction NB.SI().

Bonjour,

Code:

---

1 2 3 4 5 6 7 8 9

Sub CompteItems() Set mondico = CreateObject("Scripting.Dictionary") For Each c In Range("a2", [a65000].End(xlUp)) mondico(c.Value) = mondico(c.Value) + 1 Next c [C2].Resize(mondico.Count, 1) = Application.Transpose(mondico.keys) [d2].Resize(mondico.Count, 1) = Application.Transpose(mondico.items) End Sub

---

Jacques Boisgontier

Bonjour,

le plus simple est quand même de ne pas utiliser de code VBA mais tout simplement un tableau croisé dynamique..
http://silkyroad.developpez.com/excel/tcd/
;)

Bonjour

en fait pour obtenir ce que tu demande par vba il faut 2 étapes

en premier lieu faire une liste sans doublons des valeur dans la plage référencée

ensuite élément par éléments de cette liste la comparer a la plage référencée

pour lister sans doublons on utilisera un dictionnaire (bien pratique pour supprimer les doublons

ensuite on applique la fonction "Application.WorksheetFunction.CountIf(rnge("x:x"), item du dico)

resultat

Code:

---

1 2 3 4 5 6 7 8 9 10 11

Sub compte_les_occurences() derlig = Sheets(1).Range("a" & Rows.Count).End(xlUp).Row Set mondico = CreateObject("Scripting.Dictionary") For Each c In Sheets(1).Range("b2:b" & derlig) mondico(c.Value) = mondico(c.Value) Next c For Each elem In mondico.keys MsgBox "il y a " & Application.WorksheetFunction.CountIf(Sheets(1).Range("b2:b" & derlig), elem) + 1 & "fois " & elem & " dans cette plage" Next End Sub

---

a toi d'adapter la plage de référence

Bonjour,

Il faut le reconnaître, Jacques est le roi des dictionnaires.

Super les tableaux dynamiques ! Moi qui commençait à m'arracher les cheveux ;)