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