XL 2016 Compter le nombre de prénoms différents par nom de famille

[vincent team]

Bonjour,

Colonne A = liste de noms
Colonne B = liste de prénoms

Je voudrais compter le nombre de prénoms différents par nom, mais je ne trouve pas la solution (et l'afficher en colonne C sur chaque ligne)
Quelqu'un peut m'aider svp ?

Merci
Slts/Vince

 

[job75]

Bonjour vincent team,

C'est facile avec une fonction VBA :

Function ComptePrenom(NomPrenom As Range, nom$)
Dim d As Object, tablo, i&
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
tablo = Intersect(NomPrenom.Parent.UsedRange, NomPrenom)
nom = LCase(nom)
For i = 2 To UBound(tablo)
    If LCase(tablo(i, 1)) = nom Then d(tablo(i, 2)) = ""
Next
ComptePrenom = d.Count
End Function

Le code doit être impérativement placé dans un module standard.

A+

 

[job75]

Cela dit sur un grand tableau la solution précédente n'est absolument pas jouable.

En effet pour le calcul de chaque formule en colonne C il faut étudier tout le tableau...

Il faut alors utiliser cette macro évènementielle, voyez le fichier joint :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim tablo, ub&, i&, x$, n&, j&, k&
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
With [A1].CurrentRegion
    .Columns(1).EntireColumn.Insert 'insère une colonne auxiliaire
    .Cells(1, 0) = 1
    .Columns(0).DataSeries 'numérotation
    .EntireRow.Sort .Columns(1), xlAscending, .Columns(2), Header:=xlYes 'tri sur 2 colonnes
    tablo = .Columns(1).Resize(, 2) 'matrice, plus rapide
    ub = UBound(tablo)
    ReDim resu(1 To ub, 1 To 1)
    For i = 2 To ub
        If tablo(i, 1) <> tablo(i - 1, 1) Then
            x = tablo(i, 1)
            n = 0
            For j = i + 1 To ub
                If tablo(j, 1) <> x Then Exit For
                If tablo(j, 2) = tablo(j - 1, 2) Then n = n + 1 'compte les doublons
            Next j
            n = j - i - n
            For k = i To j - 1
                resu(k, 1) = n
            Next k
            i = j - 1
        End If
    Next i
    resu(1, 1) = .Cells(1, 3)
    .Columns(3) = resu 'restitution
    .EntireRow.Sort .Columns(0), xlAscending, Header:=xlYes 'tri dans l'ordre initial
    .Columns(0).EntireColumn.Delete 'supprime la colonne auxiliaire
End With
Application.EnableEvents = True 'réactive les évènements
End Sub

La macro se déclenche quand on modifie ou valide une cellule quelconque.

Grâce aux 2 tris l'analyse du tableau est très rapide.

Testée sur 90 000 lignes, la macro s'exécute chez moi en 0,5 seconde, c'est parfaitement acceptable.

 

[R@chid]

Bonsoir @ tous,
Salut Job75,

Si tu es intéressé par une formule, sur le fichier de l'ami Job75, en C2 :

=NB(1/FREQUENCE(SI(A$2:A$10=A2;EQUIV(A$2:A$10&B$2:B$10;A$2:A$10&B$2:B$10;0));LIGNE(INDIRECT("1:"&LIGNES(A$2:A$10)))))

@ valider par Ctrl+Maj+Entrée
@ tirer vers le bas


Cordialement

 

[vincent team]

Merci beaucoup à vous 2 d'avoir pris le temps de me répondre.

La solution de R@chid m'intéressait car plus simple à mettre en place et elle fonctionne très bien sur quelques enregistrements mais au final vu le nombre de lignes à traiter (20 000) ça moulinait beaucoup trop.
J'ai donc adpaté le code de job75 pour mon besoin.

 

[R@chid]

Bonjour @ tous,
en fait les deux sont facile à mettre en place, même la macro de l'ami Job75 ne nécessite qu'un copier/coller.
Bien sûr les formules matricielles sont très gourmandes en ressources avec des milliers de lignes d'où ma question si une formule t'intéressait.

Cordialement