Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

vincent team

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

XLDnaute Barbatruc
Bonjour vincent team,

C'est facile avec une fonction VBA :
VB:
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+
 

Pièces jointes

  • ComptePrenom(1).xlsm
    16.6 KB · Affichages: 14

job75

XLDnaute Barbatruc
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 :
VB:
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.
 

Pièces jointes

  • Comptage(1).xlsm
    20.6 KB · Affichages: 20

R@chid

XLDnaute Barbatruc
Supporter XLD
Bonsoir @ tous,
Salut Job75,

Si tu es intéressé par une formule, sur le fichier de l'ami Job75, en C2 :
VB:
=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

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

XLDnaute Barbatruc
Supporter XLD
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
 

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…