Compter le nombre de chaîne de caractère unique

sans touché au formule

J'ai même ouvert un autre classeur et j'ai écris le nom de mes 2 tableaux puis nommé dans la gestionnaire des noms, puis j'ai mis les formules. après pour vérifier si ça fonctionne j'ai commencé à mettre les données mais ça fonctionne pas dans la feuille 2.

Quel était la démarche que vous avez utilisé peut être il y a quelque chose que je fais pas bien.

Bonsoir,

Voir autre exemple sur Pj

Slts

Merci pour vos proposition.

Mais pour le fichier exemple2 je ne peux pas ajouter de nouvelle ville; ce que je veux : voir dans le fichier copie exemple2222 deposer avant. Je veux la meme sauf que ce fichier là ne marche pas si je le mets dans ma base.

pour le fichier exemple1 cest deja resolu.

Merci

Bonsoir,

Voir Pj

Slts

Bonjour le forum,

Merci pour cette proposition mais on m'a déjà proposer cette solution et je voulais que le résultat soit dans une feuille dans le classeur.

Re,

Vous pouvez me donner la démarche de comment vous avez fait pour avoir le résultat dans le tableau s'il vous plait car j'ai ouvert une autre feuille et j'ai fais la même chose mais je n'ai pas le résultat.

Merci cordialement.

Bonsoir,

Avec une fonction perso. Maj auto et très rapide (0,5 sec pour 100.000 lignes)

-Sélectionner i2:J20

=NbValUniques1critTous(A2:A30;B2:B30)

-Valider avec maj+ctrl+entrée

Boisgontier

Merci pour vos proposition.

Je peux modifier la sélection des colonnes car mes villes sont dans la colonne M et les F dans la colonne B merci.

Cordialement.

NbValUniques1critTous(BD!B2:B30;BD!M2:M30)

Bonjour,

Une fonction perso s'utilise comme une fonction standard.

-Sélectionner un champ avec 2 colonnes et x lignes

=NbValUniques1critTous(BD!B2:B100000;BD!M2:M100000)

-Valider avec maj+ctrl+entrée

Boisgontier

J'ai fait la même chose mais ça ne marche pas et ça m'affiche : #NOM?

Il faut insérer la fonction perso dans le classeur:

• Alt+F11
• Insertion/module

-Copier/Coller du code

Option Compare Text
Function NbValUniques1critTous(Valeurs As Range, Critère1)
  Application.Volatile
  TblVal = Valeurs
  Tcrit1 = Critère1
  Nlig = UBound(Tcrit1)
  NligEntrée = Application.Caller.Rows.Count
  NcolEntrée = Application.Caller.Columns.Count
  Set d = CreateObject("scripting.dictionary")
  Set d2 = CreateObject("scripting.dictionary")
  For i = 1 To Nlig
   If Tcrit1(i, 1) <> "" Then
     If Not d.exists(Tcrit1(i, 1)) Then d(Tcrit1(i, 1)) = 0
     tmp = Tcrit1(i, 1) & TblVal(i, 1)
     If Not d2.exists(tmp) Then d2(tmp) = "": d(Tcrit1(i, 1)) = d(Tcrit1(i, 1)) + 1
   End If
  Next i
  n = Application.Max(NligEntrée, NcolEntrée)
  Dim TblS(): ReDim TblS(1 To n, 1 To 2)
  i = 0
  For Each c In d.Keys
    i = i + 1
    TblS(i, 1) = c: TblS(i, 2) = d(c)
  Next c
  Tri2col TblS, 1, d.Count
  If NligEntrée >= NcolEntrée Then
     NbValUniques1critTous = TblS
  Else
     NbValUniques1critTous = Application.Transpose(TblS)
  End If
End Function

Sub Tri2col(a, gauc, droi)        ' Quick sort
 ref = a((gauc + droi) \ 2, 1) & a((gauc + droi) \ 2, 2)
 g = gauc: d = droi
 Do
     Do While a(g, 1) & a(g, 2) < ref: g = g + 1: Loop
     Do While ref < a(d, 1) & a(d, 2): d = d - 1: Loop
     If g <= d Then
       temp = a(g, 2): a(g, 2) = a(d, 2): a(d, 2) = temp
       temp = a(g, 1): a(g, 1) = a(d, 1): a(d, 1) = temp
       g = g + 1: d = d - 1
     End If
 Loop While g <= d
 If g < droi Then Call Tri2col(a, g, droi)
 If gauc < d Then Call Tri2col(a, gauc, d)
End Sub

Boisgontier

Merci pour ta proposition mais après avoir copier coller j'appelle cette fonction ou pour que ça fonctionne.