Discussion :

[Invité]

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

[Jean-Philippe André]

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

[Invité]

Ok merci. Je vais essayer çà

[Daniel.C]

Bonjour,

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

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

[Menhir]

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

[boisgontierjacques]

Bonjour,

Code :

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

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

[SfJ5Rpw8]

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/

[patricktoulon]

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"), item du dico)

resultat

Code :

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

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

[Daniel.C]

Bonjour,

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

[Invité]

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