XL 2016 Compter les doublons

[Rabeto]

Bonjour,

Je souhaite compter les doublons sans compter le premier doublon qui apparaît de la liste de chaque critère, càd, si il y a 3 valeurs en double pour X personnes, mettre 1 sur les 2 autres valeur et rien sur le premier valeur en double et pour la 2eme colonne, mettre 1 sur les valeurs en double, et rien sur le premier valeur.

Merci,

 

[JHA]

Bonjour à tous,

Un essai avec nb.si.ens()

JHA

 

[job75]

Bonjour Rabeto, JHA,

Ce n'est pas très clair, il aurait fallu indiquer les résultats attendus.

D'après ce que je comprends, formule matricielle en C2 :

=N(EQUIV(A2&B2;A$1:A$22&B$1:B$22;0)<LIGNE())

Formule normale en D2 :

=N(EQUIV(B2;B$1:B$22;0)<LIGNE())

A+

 

[job75]

Autre formule, non matricielle, en C2 :

=N(NB.SI.ENS(A$2:A2;A2;B$2:B2;B2)>1)

Et en D2 :

=N(NB.SI(B$2:B2;B2)>1)

 

[Rabeto]

Bonjour à tous,

Merci pour vos réponses, celle de Job75 a bien répondu ma demande, celui de JHA, je l'ai appliqué sur autre besoin et ça marche.

@job75, est il possible de mettre ce genre de formule en macro VBA, et de n'avoir que les résultats en valeur dans les colonnes, les formules matricielles génèrent une lenteur grave surtout si il y a plusieurs ligne.

Merci,

 

[job75]

Bonjour Rabeto, JHA,

@job75, est il possible de mettre ce genre de formule en macro VBA

Bien sûr, c'est très classique, voyez le fichier joint et la macro dans le code de la feuille :

Private Sub Worksheet_change(ByVal target As Range)
Dim d As Object, tablo, i&, x$, y$
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
With [A1].CurrentRegion.Resize(, 4)
    tablo = .Value 'matrice, plus rapide
    For i = 2 To UBound(tablo)
        tablo(i, 3) = "": tablo(i, 4) = "" 'RAZ
        x = tablo(i, 2)
        y = x & tablo(i, 1)
        If d.exists(x) Then tablo(i, 4) = 1 Else d(x) = ""
        If d.exists(y) Then tablo(i, 3) = 1 Else d(y) = ""
    Next
    '---restitution---
    Application.EnableEvents = False 'désactive les évènements
    .Value = tablo
    Application.EnableEvents = True 'réactive les évènements
End With
End Sub

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

Elle est très rapide car elle utilise un tableau VBA et 1 Dictionary.

Notez que les résultats en colonnes C et D ne peuvent pas être modifiés manuellement.

A+

 

[Rabeto]

Thank You job75,

Je pense que vous avez omis le fichier

 

[job75]

Le fichier est pourtant joint.

 

[Rabeto]

ah, merci, mais Il n'y a pas la macro dans le fichier avec le bouton à exécuter.
Puis quand j'essai de copier le code et l'insérer dans une module, ça m'affiche erreur.

 

[job75]

C'est une macro évènementielle, elle n'apparaît pas dans la liste des macros.

Comme je l'ai dit elle doit être dans le code de la feuille (clic droit sur l'onglet et Visualiser le code).

 

[Rabeto]

Bonjour job75,

Ah, j'ai trouvé comment l'activé, merci

 

[Rabeto]

Bonjour job75,

J'ai étudié le code, mais je n'arrive pas à le modifier, je veux juste l'adapter à mon fichier original, et faire juste le calcul de la colonne D mettre dans une colonne M.

Pouvez vous m'indiquer ce qui est à modifier dans ce cas svp,

merci,

 

[job75]

Bonjour Rabeto, le forum,

Je viens de corriger mon post #6 car j'avais déclaré inutilement un 2ème Dictionary.

Pour ce nouveau problème voyez ce fichier (2) et la macro :

Private Sub Worksheet_change(ByVal target As Range)
Dim d As Object, tablo, ub&, i&, resu1(), resu2(), x$, y$
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
With [A1].CurrentRegion
    tablo = .Resize(, 2) 'matrice, plus rapide
    ub = UBound(tablo)
    ReDim resu1(1 To ub, 1 To 1)
    ReDim resu2(1 To ub, 1 To 1)
    For i = 2 To ub
        x = tablo(i, 2)
        y = x & tablo(i, 1)
        If d.exists(x) Then resu1(i, 1) = 1 Else d(x) = ""
        If d.exists(y) Then resu2(i, 1) = 1 Else d(y) = ""
    Next
    '---restitution---
    resu1(1, 1) = .Cells(1, 13): resu2(1, 1) = .Cells(1, 3) 'titres
    Application.EnableEvents = False 'désactive les évènements
    .Cells(1, 13).Resize(ub) = resu1
    .Cells(1, 3).Resize(ub) = resu2
    Union(.Cells(1, 13).Resize(ub), .Cells(1, 3).Resize(ub)).Borders.Weight = xlThin 'bordures
    Application.EnableEvents = True 'réactive les évènements
End With
End Sub

Il y a 2 tableaux VBA pour les résultats en colonnes C et M.

A+

 

[Rabeto]

@job75
Je n' arrive pas à adapter le code avec mon fichier,
je vous remets le fichier et si vous pouvez adapter les résultats en prenant en compte le format du fichier en PJ svp

please

merci infiniment

 

[job75]

@job75 Je n' arrive pas à adapter le code avec mon fichier,

C'était pourtant un bon exercice qui aurait montré que vous compreniez le code.

Et pourquoi ne pas avoir présenté ce dernier fichier dès le début ?