Dénombrer éléments différents

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

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

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

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

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

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

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

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

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